IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
logo

FAQ DelphiConsultez toutes les FAQ

Nombre d'auteurs : 124, nombre de questions : 933, dernière mise à jour : 28 septembre 2024  Ajouter une question

 

Cette FAQ a été réalisée à partir des questions fréquemment posées sur les forums Delphi et Delphi et bases de données de www.developpez.com et de l'expérience personnelle des auteurs.

Nous tenons à souligner que cette FAQ ne garantit en aucun cas que les informations qu'elle propose soient correctes. Les auteurs font le maximum, mais l'erreur est humaine. Cette FAQ ne prétend pas non plus être complète. Si vous souhaitez y apporter des corrections ou la compléter, contactez un responsable (lien au bas de cette page).

Nous espérons que cette FAQ saura répondre à vos attentes. Nous vous en souhaitons une bonne lecture.

L'équipe Delphi de Developpez.com.

SommaireInterface utilisateurComposantsComposants - Divers (36)
précédent sommaire suivant
 

Il faut d'abord vérifier que notre composant peut recevoir un focus, puis le lui donner.

Code delphi : Sélectionner tout
1
2
if MyComponent.CanFocus then 
  MyComponent.SetFocus;

Mis à jour le 17 octobre 2013 Al-Yazdi

Il faut utiliser le code #13#10, code indiquant un retour à la ligne (Carriage Return et Line Feed, CRLF) ou bien sLineBreak qui est égal à #10 sous Linux ou #13#10 sous Windows.

A la conception

Il suffit pour cela de modifier le fichier .dfm ; pour ce faire, il suffit de sélectionner la fiche, puis soit faire un clic droit puis "Voir comme texte" soit faire Alt+F12. Ensuite il suffit d'éditer dans la ligne Caption ou Hint par exemple ceci :

Code delphi : Sélectionner tout
1
2
Caption = 'Première ligne' #13#10 'Seconde ligne'; 
Hint = 'Première ligne' #13#10 'Seconde ligne';

Dynamiquement

Dans l'événement OnCreate, par exemple avec un TLabel :
Code delphi : Sélectionner tout
1
2
MyLabel.Caption := 'Première ligne' + sLineBreak + 'Seconde ligne'; 
MyLabel.Hint := 'Première ligne' + sLineBreak + 'Seconde ligne';

Dans le texte d'une boîte à message :
Code delphi : Sélectionner tout
1
2
ShowMessage('Première ligne' + sLineBreak + 'Seconde ligne'); 
MessageDlg('Première ligne'+ sLineBreak + 'Seconde ligne', mtInformation, [mbOK], 0);

Ceci ne fonctionne pas avec la propriété Caption du TButton, utilisez alors le TBitBtn (onglet Supplément).

Mis à jour le 17 octobre 2013 Gysmo

L'astuce est d'utiliser la propriété BiDiMode du TControl (ancêtre des composants visibles). Ce mode bidirectionnel spécifie la direction de la lecture du texte. En localisant l'application, on arrive à aligner le texte à droite.

Dans l'événement OnCreate :

Code delphi : Sélectionner tout
1
2
3
4
{Indique une localisation moyen-orientale } 
SysLocale.MiddleEast := True; 
{Exemple avec un TEdit } 
MyEdit.BiDiMode := bdRightToLeft;
Ceci fonctionne avec la plupart des descendants du TControl : TEdit, TMaskEdit, TListBox...

Dans le cas du TEdit, il existe deux autres solutions :
  • utiliser un TMemo ayant pour hauteur la hauteur d'un TEdit et sa propriété WantReturns à false ;
  • créer un TEdit qui accepte l'alignement à droite :

Code delphi : Sélectionner tout
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
type  
  TMonEdit = class(TEdit)  
  private  
    FTextAlign: TAlignment;  
    procedure SetTextAlign(Value: TAlignment);  
  protected  
    procedure CreateParams(var Params: TCreateParams); override;  
  public  
    constructor Create(AOwner: TComponent); override;  
  published  
    property TextAlignment: TAlignment read FTextAlign write SetTextAlign;  
  end;  
implementation  
  
constructor TMonEdit.Create(AOwner: TComponent);  
begin  
  inherited;  
  FTextAlign := taLeftJustify;  
end;  
  
procedure TMonEdit.CreateParams(var Params: TCreateParams);  
const  
Alignments: array[TAlignment] of Word = (ES_LEFT, ES_RIGHT, ES_CENTER);  
begin  
inherited CreateParams(Params);  
Params.Style := Params.Style or Alignments[TextAlignment];  
end;  
  
procedure TMonEdit.SetTextAlign(Value: TAlignment);  
begin  
  if FTextAlign <>Value then  
    Begin  
    FTextAlign := Value;  
    RecreateWnd;  
  End;  
end;

Mis à jour le 17 octobre 2013 Gysmo

Il suffit de remplacer tout autre caractère par le caractère nul dans l'événement OnKeyPress du TEdit, exception faite pour le séparateur décimal (DecimalSeparator), la touche retour (VK_BACK) et la touche supprimer (VK_DELETE).

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
procedure TMyForm.MyEditKeyPress(Sender: TObject; var Key: Char); 
begin 
  if not (Key in ['0'..'9', DecimalSeparator, Chr(VK_BACK), Chr(VK_DELETE)]) then 
  Key := #0; 
  if Key = DecimalSeparator then 
    if Pos(DecimalSeparator, MyEdit.Text) <> 0 then 
      Key := #0; 
end;

En complément au code précédent, nous vous proposons également celui ci-dessous, qui permet de contrôler la saisie des chiffres ainsi que le séparateur de décimal et le signe moins :
Code delphi : Sélectionner tout
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
procedure VerNumAll(Edit: TEdit; 
    var Key: Char; Moins: Boolean = True; Virgul: Boolean = False); 
  var i, j: integer; 
  begin 
    if Key in [',', '.'] then 
      Key := DecimalSeparator; 
    if not (Key in ['0'..'9', DecimalSeparator, '-', #8]) or ((Key = '-') and not (Moins)) 
      or ((Key = DecimalSeparator) and not (Virgul)) then 
    begin 
      Key := #0; 
    end; 
    if (Key = DecimalSeparator) and (Virgul) then 
      if Pos(DecimalSeparator, Edit.Text) > 0 then 
Key := #0; 
    if (Key = DecimalSeparator) and (Virgul) then 
      if length(Edit.Text) < 1 then 
      begin 
Edit.Text := '0' + DecimalSeparator; 
Edit.SelStart := 2; 
Key := #0; 
      end; 
    if (Key = DecimalSeparator) and (Virgul) then 
      if (copy(Edit.Text, 1, 1) = '-') and (Length(Edit.Text) = 1) then 
      begin 
Edit.Text := '-0' + DecimalSeparator; 
Edit.SelStart := 3; 
Key := #0; 
      end; 
    if (Key = '-') and (Moins) then 
    begin 
      i := Edit.SelStart; 
      j := Edit.SelLength; 
      if Length(Edit.Text) > 1 then 
      begin 
if Edit.Text[1] = '-' then 
begin 
  Edit.Text := Copy(Edit.Text, 2, Length(Edit.Text) - 1); 
  if i = 0 then 
    Dec(j); 
end 
else 
  Edit.Text := '-' + Edit.Text; 
      end 
      else 
if Edit.Text = '-' then 
  Edit.Text := '' 
else 
  Edit.Text := '-' + Edit.Text; 
      if Edit.Text <> '' then 
if Edit.Text[1] = '-' then 
  i := i + 1 
else 
  i := i - 1; 
      Edit.Selstart := i; 
      Edit.SelLength := j; 
      Key := #0; 
    end; 
  end;
L'appel se fait comme suit, dans OnKeyPress :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); 
  begin 
  //Le 3eme paramètre permet de contrôler la saisie du signe 
  //moins 
  //Le 4eme paramètre permet de contrôler la saisie du 
  //séparateur de décimal   
      VerNumAll(TEdit(Sender), Key, True, True); 
  end;

Mis à jour le 17 octobre 2013 delphichem Gysmo

Cette méthode présente l'utilisation des procédures RTTI pour accéder aux propriétés des contrôles. L'exemple suivant montre comment changer la propriété Color de tous les composants qui la possèdent. C'est une solution plus efficace dans ce cas car il n'est pas nécessaire de connaître la classe du composant pour changer sa propriété Color.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
procedure TForm1.Button1Click(Sender: TObject); 
var 
  i: Integer; 
begin 
  for i:=0 to ControlCount - 1 do 
    if IsPublishedProp(Controls[i], 'Color') and PropIsType(Controls[i], 'Color', tkInteger) then 
      SetOrdProp(Controls[i], 'Color', clRed); 
end;
Pour que ce code fonctionne, il faut ajouter TypInfo dans la clause Uses.

Mis à jour le 17 octobre 2013 Pierre Castelain

Cette méthode indique comment réaliser un défilement sur le texte d'un label. Le texte va défiler de gauche à droite continuellement. Pour ce faire il faut mettre sur la fiche un Timer contenant le code suivant :

Code delphi : Sélectionner tout
1
2
3
4
5
6
procedure TForm1.Timer1Timer(Sender: TObject); 
Const Saut=1; 
begin 
  Label1.Caption:=Copy(Label1.Caption,Saut+1,Length(Label1.Caption)-Saut) 
  +Copy(Label1.Caption,1,Saut) ; 
end;
La période doit être réglée sur 100 ms environ. La constante "saut" indique de combien de caractères le label avance à chaque pas du timer.

Astuce amusante :

Mettre les propriété AutoSize et WordWrap du label à False. Puis saisir dans le Caption un texte beaucoup plus long que la zone d'affichage. La fin du texte ne sera visible qu'au bout d'un certain temps comme un vrai texte défilant.

Mis à jour le 17 octobre 2013 Nono40

Il est parfois intéressant de pouvoir obtenir la position du caractère le plus proche d'un point en coordonnées écran. Il existe un message Windows permettant de réaliser cette opération : EM_CHARFROMPOS.

Voici une fonction utilisant ce message et utilisable avec des contrôles d'édition simple et des RichEdit.

Code delphi : Sélectionner tout
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
function ClientPosToCharIndex(AnEdit: TCustomEdit; ClientPos: TPoint): Integer; 
var 
  lParam: Integer; 
begin 
  { Le format du paramètre LParam étant différent selon le type de composant } 
  { il nous faut tester s'il s'agit d'un RichEdit ou d'un simple Edit (ou Memo).} 
  
  if AnEdit is TRichEdit then 
  begin 
    { Dans le cas d'un RichEdit, le paramètre représente l'adresse d'une } 
    { structure de type TRect contenant la position en coordonnées écran } 
    { relative au composant.} 
    lParam:= Integer(@ClientPos); 
  
    { La valeur retournée correspond à l'index absolu du caractère le plus } 
    { près du point ou du dernier caractère si le point est plus bas que le } 
    { dernier caractère du contrôle. } 
    result:= AnEdit.Perform(EM_CHARFROMPOS, 0, lParam); 
  end 
  else 
  begin 
    { Dans le cas d'un Edit, le paramètre contient deux mots correspondants } 
    { à la position en coordonnées écran relative au composant. Le mot de poids } 
    { faible contient la position horizontale (X) et le mot de poids fort la } 
    { position verticale (Y) } 
    lParam:= ClientPos.Y shl 16 + ClientPos.X; 
  
    { La valeur retournée contient l'index absolu du caractère ainsi que } 
    { l'index de la ligne. } 
    { Le mot de poids faible correspond à l'index absolu du caractère le plus } 
    { près du point ou du dernier caractère si le point est plus bas que le } 
    { dernier caractère du contrôle. } 
    { Le mot de poids fort (l'index de la ligne) n'est pas utilisé dans cet } 
    { exemple. } 
    result:= LoWord(AnEdit.Perform(EM_CHARFROMPOS, 0, lParam)); 
  end; 
end;

Le code suivant est un exemple simple d'utilisation de cette fonction. Celui-ci affiche dans un label le caractère le plus proche du curseur lorsque l'on le déplace sur un Memo.
Dans une feuille, placez un composant de type TMemo (appelé Memo1) ainsi qu'un composant de type TLabel (appelé Label1). Dans l'inspecteur d'objet, faites un double click sur l'évènement OnMouseMove et modifiez le code généré comme ceci:
Code delphi : Sélectionner tout
1
2
3
4
5
procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X, 
  Y: Integer); 
begin 
  Label1.Caption:= Memo1.Lines.Text[ClientPosToCharIndex(Memo1, Point(X, Y))]; 
end;

Mis à jour le 17 octobre 2013 Pierre Castelain

Les MessageDlg sont des petites boîtes de dialogue qu'on utilise très souvent pour alerter, informer ou poser une question à l'utilisateur. On les crée grâce à la fonction :

Code Delphi : Sélectionner tout
1
2
3
4
MessageDlg(const Msg: string; 
  DlgType: TMsgDlgType; 
  Buttons: TMsgDlgButtons; 
  HelpCtx: Longint): Word;
Il peut être intéressant, dans certains cas, d'ajouter une case à cocher, généralement « Ne plus afficher ce message ». Étant donné que cette possibilité n'est pas prévue en standard, il faut réécrire notre propre MessageDlg :
Code Delphi : Sélectionner tout
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
function MDChecked(const Msg,                  { Message à afficher} 
  ChkMsg: string;             { Message de la case à cocher} 
  var checkedValue : boolean; { Valeur de la case à cocher} 
  DlgType: TMsgDlgType;       { Type de la boite de message} 
  Buttons: TMsgDlgButtons)    { boutons} 
  : Word; 
var 
  chk : TCheckBox; 
  frm : TForm; 
begin 
  frm := CreateMessageDialog(Msg, DlgType, Buttons); 
  with frm do 
  try 
    { Ajout d'une case à cocher en bas à gauche} 
    chk := TCheckBox.Create(frm); 
    with chk do 
    begin 
      Checked := checkedValue; 
      Caption := chkMsg; 
      Left := 8; 
      Top := frm.Height - Height - 12; 
      Width := frm.width - left - 1; 
      Parent := frm; 
    end; 
    { Agrandissement de la fenêtre} 
    Height := Height + chk.Height; 
    Position := poScreenCenter; 
    { Affichage} 
    Result := ShowModal; 
    { Récupération de la case à cocher} 
    checkedValue := chk.Checked; 
  finally 
    Free; 
  end; 
end;

Exemple d'utilisation :
Code Delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
var 
  chk : boolean;  
... 
  if ParametresAppli.AfficherMessage then 
  begin 
    chk := false; 
    MDChecked('Bla bla bla…','Ne plus afficher ce message',chk,mtInformation,[mbOK]); 
    { on inverse la valeur car le texte associé } 
    { à la case à cocher est l'inverse de ce qu'on stocke} 
    ParametresAppli.AfficherMessage := not chk; 
  end;

ParametresAppli.AfficherMessage est un paramètre de votre application, stocké dans un .ini ou dans la base de registre.

Voir également l'aide de Delphi sur MessageDlg, afin d'avoir toutes les précisions sur TMsgDlgType et TMsgDlgButtons.

Mis à jour le 17 octobre 2013 Bloon

Dans Delphi 6 et Delphi 7, l'unité dsgnintf n'existe plus.

Elle a été renommée et certains changements sont nécessaires
pour installer certains composants faits avec d'anciennes versions de Delphi. Dans la plupart des cas il suffit de remplacer dsgnintf par DesignIntf, DesignEditors.

Mis à jour le 22 janvier 2014 DelphiCool

Adobe propose un outil gratuit de visualisation appelé Acrobat Reader. L'installation de cet outil intègre un contrôle ActiveX qui peut être utilisé pour afficher des documents PDF dans n'importe quelle application développée avec un langage supportant les objets COM. Il est donc très facile d'utiliser ce contrôle ActiveX dans une application Delphi.

Il vous faut commencer par installer Acrobat Reader sur votre ordinateur de développement. Notez que cette installation sera également nécessaire sur les ordinateurs devant exécuter votre programme. Vous pouvez trouver le programme d'installation ici : http://get.adobe.com/reader/

Une fois l'installation terminée, vous devez importer le contrôle ActiveX dans Delphi. Celui-ci s'appelle "Acrobat Control for ActiveX" et peut être importé en suivant la procédure décrite dans la FAQ Delphi : Comment installer un contrôle ActiveX ?

Si vous avez suivi la procédure sans modifier le nom de la palette utilisée, vous devriez trouver un nouveau composant dans la palette ActiveX. Ce nouveau composant intitulé TPdf peut être posé sur une fenêtre Delphi comme n'importe quel autre composant.

Vous pouvez à présent l'utiliser dans votre application en utilisant sa méthode LoadFile :

Code delphi : Sélectionner tout
Pdf1.LoadFile('fichier.pdf');
Pour plus d'information sur les méthodes proposées par ce composant, vous pouvez étudier l'unité Delphi contenant la définition de ses interfaces (par défaut PdfLib_TLB.pas située dans le dossier Imports de Delphi) ou télécharger les documents fournis par Adobe à l'adresse suivante : http://partners.adobe.com/public/dev...sdk/index.html
Le téléchargement de certains documents nécessite de s'être enregistré sur le site mais cet enregistrement est gratuit et sans restriction particulière.

Mis à jour le 21 janvier 2014 Pierre Castelain

Pour effacer l'image affichée dans un TImage, il suffit d'assigner nil à sa propriété Picture :

Code delphi : Sélectionner tout
Image1.Picture := nil;

Mis à jour le 21 janvier 2014 Smortex

Il arrive très souvent que l'on veuille donner le focus au contrôle suivant (dans l'ordre spécifié par la propriété TabOrder) dans un formulaire à condition que ce contrôle ait TabStop à True. Nous utilisons ici un gestionnaire d'évènement commun à tous les contrôles TEdit qui passera au contrôle suivant si nous appuyons sur Entrée :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
procedure TMainForm.GoToNextEditControls(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  if key = VK_RETURN then  
PostMessage(self.Handle,WM_NEXTDLGCTL,0,0); 
//Nous pouvons aussi utiliser : perform(WM_NEXTDLGCTL,0,0); 
end;

Mis à jour le 21 janvier 2014 Giovanny Temgoua

Vous utilisez un composant SynEdit dans votre application, et vous voudriez que, comme dans Delphi, l'aide s'affiche automatiquement lors d'un appui sur F1.

Deux choses sont à faire :

La première n'est pas obligatoire avec toutes les versions de SynEdit.
Double-cliquez sur la propriété KeysStrokes du composant SynEdit. Dans le fenêtre qui s'affiche, cliquez sur le bouton Add. Dans le champ Command, entrez ecContextHelp, et dans un des champs Keystroke, entrez F1.

La deuxième est de placer le code suivant dans l'événement OnContextHelp du composant SynEdit :

Code delphi : Sélectionner tout
1
2
3
4
procedure TForm1.SynEdit1ContextHelp(Sender: TObject; word: String); 
begin 
  Application.HelpKeyword(word); 
end;

Mis à jour le 21 janvier 2014 sjrd

Lorsque l'on effectue de nombreuses opérations dans un composant liste (TListBox, TListView, etc), l'affichage a tendance à scintiller. C'est tout à fait normal car ces composants rafraîchissent leur aspect visuel à chaque opération.
Pour éviter ce phénomène, il suffit d'utiliser un mécanisme implémenté dans les classes dérivées de TStrings (TStringList en particulier) permettant de bloquer temporairement l'envoi de messages de mise à jour lors des modifications. Ce mécanisme est mis en oeuvre grâce aux méthodes BeginUpdate et EndUpdate.
En voici un exemple avec un composant TListBox :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
procedure TForm1.Button1Click(Sender: TObject); 
var 
  i: Integer; 
begin 
  { Dans cet exemple, nous vidons le TListBox et y ajoutons un grand nombre 
    de chaînes. Nous avons placé l'appel à EndUpdate dans un bloc finally 
    afin d'être certains qu'il soit toujours appelé, même si une exception 
    est levée pendant le remplissage. } 
  
  ListBox1.Items.BeginUpdate; 
  try 
    ListBox1.Items.Clear; 
    for i:= 0 to 99999 do 
      ListBox1.Items.Add(IntToStr(i)); 
  finally 
    ListBox1.Items.EndUpdate; 
  end; 
end;

Mis à jour le 21 janvier 2014 Pierre Castelain

Pour cacher la barre de menu d'une fiche, il suffit de mettre sa propriété Menu à nil :

Code delphi : Sélectionner tout
Self.Menu := nil;
Pour la réactiver, on remet juste le nom du Menu
Code delphi : Sélectionner tout
Self.Menu := MainMenu1;

Mis à jour le 21 janvier 2014 Giovanny Temgoua

Le code suivant permet de vérifier que deux objets de classe TGraphic sont identiques. Elle permet de comparer l'ensemble des types d'images supporté par cette classe (bitmap, metafile, icone).

Code delphi : Sélectionner tout
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
function CompareGraphic(const Graphic1, Graphic2: TGraphic): boolean;  
var  
  MyImage1, MyImage2: TMemoryStream;  
begin  
  // Code librement adapté de la fonction TGraphic.Equals  
 //Si l'un des deux vaut nil... 
  if Graphic1 = nil then  
    result:= Graphic2 = nil  
  else if Graphic2 = nil then  
  begin  
    result:= false;  
    exit;  
  end  
  else  
  begin  
    Result:= Graphic1.ClassType = Graphic2.ClassType;  
   //Si l'un des deux est vide 
    if Graphic1.Empty then  
      result:= Graphic2.Empty  
    else  
    begin  
      if result then  
      begin  
        MyImage1 := TMemoryStream.Create;  
        try  
          Graphic1.SaveToStream(MyImage1);  
          MyImage2 := TMemoryStream.Create;  
          try  
            Graphic2.SaveToStream(MyImage2);  
             //On compare la taille des images et la taille binaire des images en mémoire 
            Result := (MyImage1.Size = MyImage2.Size) and  
              CompareMem(MyImage1.Memory, MyImage2.Memory, MyImage1.Size);  
          finally  
            MyImage2.Free;  
          end;  
        finally  
          MyImage1.Free;  
        end;  
      end;  
    end;  
  end;  
end;

Mis à jour le 21 janvier 2014 Pierre Castelain

Il n'existe pas de composant standard pour simuler un lien hypertexte. Il faut passer par un composant tiers comme le TJvLinkLabel (de la JVCL) ou utiliser le code ci-dessous.
L'astuce utilisée est tout simplement d'intercepter l'événement OnClick d'un TLabel et d'utiliser la fonction ShellExecute avec l'URL à atteindre comme destination.
Le code du clic sur le label est le suivant :

Code delphi : Sélectionner tout
1
2
3
4
5
procedure TAboutBox.Label1Click(Sender: TObject); 
begin 
   ShellExecute(Handle,'OPEN','http://www.Developpez.com', 
                       Nil,Nil,SW_SHOW); 
end;
La fonction ShellExecute est définie dans l'unité ShellApi, il faudra donc penser à l'ajouter dans la clause uses.

Pour que visuellement l'utilisateur puisse savoir qu'il s'agit d'un "lien", on peut en plus configurer la forme du curseur sur le TLabel en lui donnant la valeur crHand et gérer les événements OnMouseEnter et OnMouseLeave de cette façon
Code delphi : Sélectionner tout
1
2
3
4
procedure TAboutBox.Label1MouseEnter(Sender: TObject);  
begin  
  Label1.Font.Color := clBlue;  
end;
Code delphi : Sélectionner tout
1
2
3
4
procedure TAboutBox.Label1MouseLeave(Sender: TObject);  
begin  
  Label1.Font.Color := clNavy;  
end;

Mis à jour le 21 janvier 2014 Bestiol Giovanny Temgoua

Il suffit d'utiliser un objet TControlCanvas qui se charge d'associer un canvas à un contrôle qui n'en a pas…

Pour ce faire, on utilise sa propriété Control qui détermine le contrôle auquel associer la surface de dessin.
Ensuite on utilise le TControlCanvas comme un canvas standard de TForm par exemple.

Le code suivant illustre ce principe :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
var fCanvas: TControlCanvas; 
  
procedure TForm1.CreateClick(Sender: TObject); 
begin 
  fcanvas:=TControlCanvas.Create; 
  fcanvas.Control := Edit1;  // Edit1 est un TEdit 
end; 
  
procedure TForm1.UseClick(Sender: TObject); 
begin 
  fCanvas.Brush.Color := clRed; 
  fCanvas.Rectangle(1, 1,  15, 15); 
  fCanvas.Brush.Color := clWhite; 
  fCanvas.TextOut(17, 0, 'rouge'); 
  //Edit1 contient maintenant un carré rouge puis le texte 'rouge' 
end; 
  
procedure TForm1.freeClick(Sender: TObject); 
begin 
  fCanvas.Free; 
end;

Mis à jour le 21 janvier 2014 sioux

Pour restreindre la saisie de l'utilisateur à des majuscules dans un TMemo, on peut utiliser le code suivant dans l'évènement OnKeyPress :

Code delphi : Sélectionner tout
Key := UpCase(Key);
Cependant, cette méthode ne gère pas les caractères accentués !

Pour gérer correctement les caractères accentués, on peut utiliser le code suivant, en exploitant le gestionnaire de l'évènement OnCreate de la fiche :
Code delphi : Sélectionner tout
TEdit(Memo1).CharCase := ecUpperCase;
Plus générallement, le code suivant fonctionne pour tous les descendants de TCustomEditControl :
Code delphi : Sélectionner tout
SetWindowLong(Memo1.Handle,GWL_STYLE,GetWindowLong(Memo1.Handle,GWL_STYLE)Or ES_UPPERCASE);

Mis à jour le 21 janvier 2014 DMO Nono40

Prenons un exemple, vous avez ce code sur l'évènement OnKeyPress d'une TForm appelée Fiche1 :

Code delphi : Sélectionner tout
1
2
3
4
procedure TFiche1.FormKeyPress(Sender: TObject; var Key: Char)  
begin  
  MessageDlg(Format('La touche %c a été enfoncée',[Key]).',mtInformation,[mbOk],0);  
end;
Pour pouvoir appeler cette procédure ailleurs dans le code, il existe deux méthodes.

Par exemple, vous voulez que l'évènement se produise avec la touche 'p'.
Il faut donc :
Soit directement appeler :
Code delphi : Sélectionner tout
FormKeyPress(Fiche1, 'p');
Note : ici, Fiche1 peut être remplacé par self.

Soit appeler le membre de TFiche1 :
Code delphi : Sélectionner tout
1
2
3
4
5
var c:char;  
begin  
c:='p';  
Fiche1.OnKeyPress(Fiche1, c);  
end;
ou encore
Code delphi : Sélectionner tout
1
2
3
4
5
var c:char;  
begin  
c:='p';  
self.OnKeyPress(self, c);  
end;
Note : Dans les exemples précédents, puisque l'on ne se sert pas de Sender, il est inutile de passer quoi que ce soit dans les paramètres. On peut alors directement appeler :
Code delphi : Sélectionner tout
FormKeyPress(nil,c);

Mis à jour le 21 janvier 2014 Pedro

Afin d'avoir des couleurs dans un TMenuItem, vous devez, comme l'aide Delphi le précise, soit passer la valeur de la propriété OwnerDraw du menu parent à True ou vous assurer que le menu parent a une propriété Images non nil.
Ensuite, l'événement OnDrawItem ou OnAdvancedDrawItem est utilisé pour dessiner dans le canevas du TMenuItem.
L'unité suivante (à inclure dans votre projet) vous permet de mettre des couleurs dans vos TMenuItem :

Code delphi : Sélectionner tout
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
unit UnitMenusCouleurs;  
  
interface  
uses Windows,Menus,Graphics,types;  
  
type  
  TMenuItemHelper=class(TMenuItem)  
  public  
    procedure DoAdvancedDrawItem(ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);  
  end;  
  
implementation  
  
procedure TMenuItemHelper.DoAdvancedDrawItem(  
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);  
var IsTopLevel:Boolean;  
    OldEvent:TAdvancedMenuDrawItemEvent;  
begin  
  OldEvent:=OnAdvancedDrawItem;  
  OnAdvancedDrawItem:=nil;  
  IsTopLevel:=(GetParentComponent is TMainMenu);  
  AdvancedDrawItem(ACanvas,ARect,State,IstopLevel);  
  OnAdvancedDrawItem:=OldEvent;  
end;  
  
end.
Son utilisation est assez simple.

Dans l'unité de la fiche ou se trouve votre menu, dans la partie implementation, rajoutez UnitMenusCouleurs dans les uses, comme ceci :
Code delphi : Sélectionner tout
1
2
3
4
5
...  
implementation  
uses UnitMenusCouleurs;  
{$R *.dfm}  
...
ensuite, on code l'événement du TMenuItem comme ainsi :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
procedure TForm1.UnMenuItem2AdvancedDrawItem(Sender: TObject;  
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);  
begin  
  ACanvas.Font.Color:=clRed;  
  ACanvas.Brush.Color:=clYellow;  
  TMenuItemHelper(Sender).DoAdvancedDrawItem(ACanvas,ARect,State);  
end;
Il existe aussi les objets TAdvMainMenu, TAdvMenuItem… de chez www.tmssoftware.com.
Ces composants sont gratuits.

Mis à jour le 21 janvier 2014 LadyWasky

Tout d'abord, voici une unité à ajouter à votre projet :

Code delphi : Sélectionner tout
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 UnitSuperMenus;  
  
interface  
uses Windows, Classes, Menus,Graphics,types,ImgList;  
  
type  
  TImageIndex=type Integer;  
  
  TMenuItemPublic=class(TComponent)  
  public  
    FCaption: string;  
    FHandle: HMENU;  
    FChecked: Boolean;  
    FEnabled: Boolean;  
    FDefault: Boolean;  
    FAutoHotkeys: TMenuItemAutoFlag;  
    FAutoLineReduction: TMenuItemAutoFlag;  
    FRadioItem: Boolean;  
    FVisible: Boolean;  
    FGroupIndex: Byte;  
    FImageIndex: TImageIndex;  
    FActionLink: TMenuActionLink;  
    FBreak: TMenuBreak;  
    FBitmap: TBitmap;  
    FCommand: Word;  
    FHelpContext: THelpContext;  
    FHint: string;  
    FItems: TList;  
    FShortCut: TShortCut;  
    FParent: TMenuItem;  
    FMerged: TMenuItem;  
    FMergedWith: TMenuItem;  
    FMenu: TMenu;  
    FStreamedRebuild: Boolean;  
    FImageChangeLink: TChangeLink;  
    FSubMenuImages: TCustomImageList;  
    FOnChange: TMenuChangeEvent;  
    FOnClick: TNotifyEvent;  
    FOnDrawItem: TMenuDrawItemEvent;  
    FOnAdvancedDrawItem: TAdvancedMenuDrawItemEvent;  
    FOnMeasureItem: TMenuMeasureItemEvent;  
    FAutoCheck: Boolean;  
  end;  
  
  TMenuItemHelper=class(TMenuItem)  
  public  
    procedure DoAdvancedDrawItem(ACanvas: TCanvas; ARect: TRect;  
      State: TOwnerDrawState; NewIndex:Integer);  
  end;  
  
implementation  
uses SysUtils;  
  
  
{ TMenuItemHelper }  
  
procedure TMenuItemHelper.DoAdvancedDrawItem(ACanvas: TCanvas;  
  ARect: TRect; State: TOwnerDrawState;  
  NewIndex: Integer);  
var OldMenuDrawItemEvent:TMenuDrawItemEvent;  
    OldAdvancedMenuDrawItemEvent:TAdvancedMenuDrawItemEvent;  
    IsTopLevel:Boolean;  
begin  
  OldMenuDrawItemEvent:=OnDrawItem;  
  OldAdvancedMenuDrawItemEvent:=OnAdvancedDrawItem;  
  OnDrawItem:=nil;  
  OnAdvancedDrawItem:=nil;  
  TMenuItemPublic(Self).FImageIndex:=NewIndex;  
  IsTopLevel:=(GetParentComponent is TMainMenu);  
  AdvancedDrawItem(ACanvas,ARect,State,IsTopLevel);  
  OnDrawItem:=OldMenuDrawItemEvent;  
  OnAdvancedDrawItem:=OldAdvancedMenuDrawItemEvent;  
end;  
  
end.
Exemple d'utilisation :
Nous avons ici deux TMenuItem déclarés dans un TMainMenu,, relié par sa propriété ImageList à une liste d'images (Ils auraient pu être des éléments d'un TPopupMenu aussi…)

Le premier s'appelle HelpItem, le second ExitItem, et on a codé leurs évènements OnAdvancedDrawItem comme ceci : (La propriété OwnerDraw du menu parent doit être à True)
Code delphi : Sélectionner tout
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
procedure TForm1.HelpItemAdvancedDrawItem(Sender: TObject;  
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);  
var NewImageIndex:Integer;  
begin  
  // En fonction de l'état de l'élément de menu, on assigne un Nouvel ImageIndex  
  if (OdSelected   in State)  
  then NewImageIndex:=1  
  else NewImageIndex:=2;  
 // Puis on effectue le dessin du MenuItem comme ceci  :  
TMenuItemHelper(Sender).DoAdvancedDrawItem(ACanvas,ARect,State,NewImageIndex);  
end;  
  
procedure TForm1.ExitItemAdvancedDrawItem(Sender: TObject;  
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);  
var NewImageIndex:Integer;  
begin  
  // Bonus1 : on en profite pour changer la Police du MenuItem  
  ACanvas.Font.Color:=clRed;  
  // ...et sa couleur d'arrière plan (voir rubriques connexes)  
  ACanvas.Brush.Color:=clYellow;  
  
  // En fonction de l'état de l'élément de menu, on assigne un Nouvel ImageIndex  
  if (OdSelected   in State)  
  then NewImageIndex:=3  
  else NewImageIndex:=4;  
  //Puis on effectue le dessin du MenuItem comme ceci  :  
TMenuItemHelper(Sender).DoAdvancedDrawItem(ACanvas,ARect,State,NewImageIndex);  
end;

Mis à jour le 21 janvier 2014 LadyWasky

Il suffit de créer votre TMainMenu comme vous le souhaitez, d'ajouter une TToolBar dans le TPanel (ou n'importe quel autre conteneur), puis d'utiliser la propriété Menu dans laquelle vous spécifiez le TMainMenu.

Note : Il vaut mieux créer le TMainMenu et ses menus d'abord puisque les modifications sur celui-ci ne se reflètent pas sur la TToolBar. Pour mettre à jour, vous devez enlever le TMainMenu de la propriété Menu puis le remettre.

Mis à jour le 21 janvier 2014 Pedro

Qui n'a jamais rencontré le problème de savoir comment écrire un texte qui plus est multiligne, bien centré dans une zone particulière d'un canvas ?
L'utilisation de la méthode TCanvas.TextOut (trop limitée ?) ou de la fonction DrawText de l'API Windows (trop complexe ?) se révèle être décourageante pour qui souhaite par exemple afficher un texte de trois lignes dans la cellule d'un TStringGrid.

La fonction suivante utilise la fonction TextSize déjà décrite dans l'une de nos FAQs : Comment connaître la largeur et la hauteur en pixels d'un texte ?

Code delphi : Sélectionner tout
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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
interface 
... 
type 
  TAlignementVertical=(alVTop,alVCenter,alVBottom); 
  TAlignementHorizontal=(alHLeft,alHCenter,alHRight); 
  TJustification=(JustLeft,JustCenter,JustRight); 
  procedure DessineTexteMultiligne(AString:string;ACanvas:TCanvas;ARect: TRect; 
                       AlignementHorizontal:TAlignementHorizontal; 
                       AlignementVertical:TAlignementVertical; 
                       TextJustification:TJustification); 
... 
implementation 
  
// Voir FAQ Delphi de www.developpez.com pour cette fonction : 
// URL : http://delphi.developpez.com/faq/?page=Chaines-de-caracteres#Comment-connaitre-la-largeur-et-la-hauteur-en-pixels-d-un-texte 
Function TextSize(Phrase : string; Police : TFont = nil) : TPoint; 
var 
  DC: HDC; 
  X: Integer; 
  Rect: TRect; 
  C : TBitmap; 
begin 
  C := TBitmap.create; 
  if police <> nil then  C.canvas.Font := police; 
  
    Rect.Left := 0; 
    Rect.Top:=0; 
    Rect.Right:=0; 
    Rect.Bottom:=0; 
    DC := GetDC(0); 
    C.Canvas.Handle := DC; 
    DrawText(C.Canvas.Handle, PChar(Phrase), -1, Rect, (DT_EXPANDTABS or DT_CALCRECT)); 
    C.Canvas.Handle := 0; 
    ReleaseDC(0, DC); 
    result.X:=Rect.Right-Rect.Left; 
    result.Y:=Rect.Bottom-Rect.Top; 
    C.Free; 
end; 
  
// Notre procedure d'affichage de texte multiligne 
procedure DessineTexteMultiligne(AString: string;ACanvas:TCanvas;ARect: TRect; 
                       AlignementHorizontal:TAlignementHorizontal; 
                       AlignementVertical:TAlignementVertical; 
                       TextJustification:TJustification); 
var 
  AHeight,AWidth:integer; 
  Rect,oldClipRect:TRect; 
  ATop,ALeft,H,W:Integer; 
  AText:string; 
  JustificationDuTexte:Integer; 
  MyRgn:HRGN; 
begin 
  with ACanvas do 
  begin 
    Lock; 
    AHeight:=ARect.Bottom-ARect.Top; 
  
    AWidth:=ARect.Right-ARect.Left; 
    // On calcule la taille du rectangle dans lequel va tenir le texte 
    W:=TextSize(AString,ACanvas.Font).X; 
    H:=TextSize(AString,ACanvas.Font).Y; 
  
    // On calcule la position (Haut,Gauche) du rectangle dans lequel va tenir le texte 
    // en fonction de l'alignement horizontal et vertical choisi 
    ATop:=ARect.Top; 
    ALeft:=ARect.Left; 
  
  
    case AlignementVertical of 
      alVBottom : ATop:=ARect.Bottom-H; 
      alVCenter : ATop:=ARect.Top+((AHeight-H) div 2); 
      alVTop    : ATop:=ARect.Top; 
    end; 
  
    case AlignementHorizontal of 
      alHLeft  : ALeft:=ARect.Left; 
      alHCenter: ALeft:=ARect.Left+(AWidth-W) div 2; 
      alHRight : ALeft:=ARect.Right-W; 
    end; 
  
    // Fin du calcul du rectangle, on met le resultat dans Rect 
    Rect:=Bounds(ALeft,ATop,W,H); 
  
    //On remplit le rectangle de la zone sinon on voit le texte que delphi à dessiné 
    FillRect(ARect); 
  
    // On détermine les paramètres de justification à passer à Windows 
    case TextJustification of 
      JustLeft  : JustificationDuTexte:=DT_LEFT; 
      JustCenter: JustificationDuTexte:=DT_CENTER; 
      JustRight : JustificationDuTexte:=DT_RIGHT; 
    end; 
  
    // Si le texte est plus grand que notre zone, on prend cette précaution (Clipping) 
    with ARect do MyRgn :=CreateRectRgn(Left,Top,Right,Bottom); 
    SelectClipRgn(Handle,MyRgn); 
  
    // On dessine le texte 
    DrawText(Handle,PChar(AString),-1,Rect,JustificationDuTexte or DT_NOPREFIX or DT_WORDBREAK ); 
  
    // On a plus besoin de la zone de clipping 
    SelectClipRgn(Handle,0); 
    DeleteObject(MyRgn); 
    Unlock; 
  end; 
end;
Utilisation de la procédure DessineTexteMultiligne :
  • AString: string;
    Chaîne de caractère à dessiner.

  • ACanvas:TCanvas;
    Canvas où le texte doit être dessiné

  • ARect: TRect;
    Zone rectangulaire du Canvas dans laquelle le texte doit être dessiné

  • AlignementHorizontal:TAlignementHorizontal;
    Alignement Horizontal du texte dans la zone rectangulaire, trois options sont possibles :
    • alHLeft : Place le texte à gauche dans la zone rectangulaire.
    • alHCenter : Centre le texte horizontalement dans la zone rectangulaire.
    • alHRight : Place le texte à droite dans la zone rectangulaire.

  • AlignementVertical:TAlignementVertical;
    Alignement Vertical du texte dans la zone rectangulaire, trois options sont possibles :
    • alVTop : Place le texte en haut de la zone rectangulaire.
    • alVCenter : Centre le texte verticalement dans la zone rectangulaire.
    • alVBottom : Place le texte en bas de la zone rectangulaire.

  • TextJustification:TJustification
    Justification du texte
    • JustLeft : Justifie le texte à gauche
    • JustCenter : Justification centrée du texte
    • JustRight : Justifie le texte à droite

Note concernant le choix du type des paramètres de la procédure :
L'utilisation des types déjà existants de Delphi est tout aussi valable, à savoir :
  • AlignementVertical:TTextLayout;
  • AlignementHorizontal:TAlignement;
  • TextJustification:TAlignment;

Ces types sont déclarés dans les unités StdCtrls et Classes.

Mis à jour le 21 janvier 2014 LadyWasky

Qui n'a jamais rencontré le problème de savoir comment écrire un texte qui plus est multiligne, bien centré dans une zone particulière d'un canvas ?
L'utilisation de la méthode TCanvas.TextOut (trop limitée ?) ou de la fonction DrawText de l'API Windows (trop complexe ?) se révèle être décourageante pour qui souhaite par exemple afficher un texte de trois lignes dans la cellule d'un TStringGrid.

La fonction suivante utilise la fonction TextSize déjà décrite dans l'une de nos FAQs : Comment connaître la largeur et la hauteur en pixels d'un texte ?

Code delphi : Sélectionner tout
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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
interface 
... 
type 
  TAlignementVertical=(alVTop,alVCenter,alVBottom); 
  TAlignementHorizontal=(alHLeft,alHCenter,alHRight); 
  TJustification=(JustLeft,JustCenter,JustRight); 
  procedure DessineTexteMultiligne(AString:string;ACanvas:TCanvas;ARect: TRect; 
                       AlignementHorizontal:TAlignementHorizontal; 
                       AlignementVertical:TAlignementVertical; 
                       TextJustification:TJustification); 
... 
implementation 
  
//Voir FAQ Delphi de www.developpez.com pour cette fonction : 
//URL : http://delphi.developpez.com/faq/?page=http://delphi.developpez.com/faq/?page=Chaines-de-caracteres#Comment-connaitre-la-largeur-et-la-hauteur-en-pixels-d-un-texte 
Function TextSize(Phrase : string; Police : TFont = nil) : TPoint; 
var 
  DC: HDC; 
  X: Integer; 
  Rect: TRect; 
  C : TBitmap; 
begin 
  C := TBitmap.create; 
  if police <> nil then  C.canvas.Font := police; 
  
    Rect.Left := 0; 
    Rect.Top:=0; 
    Rect.Right:=0; 
    Rect.Bottom:=0; 
    DC := GetDC(0); 
    C.Canvas.Handle := DC; 
    DrawText(C.Canvas.Handle, PChar(Phrase), -1, Rect, (DT_EXPANDTABS or DT_CALCRECT)); 
    C.Canvas.Handle := 0; 
    ReleaseDC(0, DC); 
    result.X:=Rect.Right-Rect.Left; 
    result.Y:=Rect.Bottom-Rect.Top; 
    C.Free; 
end; 
  
//Notre procedure d'affichage de texte multiligne 
procedure DessineTexteMultiligne(AString: string;ACanvas:TCanvas;ARect: TRect; 
                       AlignementHorizontal:TAlignementHorizontal; 
                       AlignementVertical:TAlignementVertical; 
                       TextJustification:TJustification); 
var 
  AHeight,AWidth:integer; 
  Rect,oldClipRect:TRect; 
  ATop,ALeft,H,W:Integer; 
  AText:string; 
  JustificationDuTexte:Integer; 
  MyRgn:HRGN; 
begin 
  with ACanvas do 
  begin 
    Lock; 
    AHeight:=ARect.Bottom-ARect.Top; 
  
    AWidth:=ARect.Right-ARect.Left; 
    // On calcule la taille du rectangle dans lequel va tenir le texte 
    W:=TextSize(AString,ACanvas.Font).X; 
    H:=TextSize(AString,ACanvas.Font).Y; 
  
    // On calcule la position (Haut,Gauche) du rectangle dans lequel va tenir le texte 
    // en fonction de l'alignement horizontal et vertical choisi 
    ATop:=ARect.Top; 
    ALeft:=ARect.Left; 
  
  
    case AlignementVertical of 
      alVBottom : ATop:=ARect.Bottom-H; 
      alVCenter : ATop:=ARect.Top+((AHeight-H) div 2); 
      alVTop    : ATop:=ARect.Top; 
    end; 
  
    case AlignementHorizontal of 
      alHLeft  : ALeft:=ARect.Left; 
      alHCenter: ALeft:=ARect.Left+(AWidth-W) div 2; 
      alHRight : ALeft:=ARect.Right-W; 
    end; 
  
    // Fin du calcul du rectangle, on met le resultat dans Rect 
    Rect:=Bounds(ALeft,ATop,W,H); 
  
    // On remplit le rectangle de la zone sinon on voit le texte que delphi à dessiné 
    FillRect(ARect); 
  
    // On détermine les paramètres de justification à passer à Windows 
    case TextJustification of 
      JustLeft  : JustificationDuTexte:=DT_LEFT; 
      JustCenter: JustificationDuTexte:=DT_CENTER; 
      JustRight : JustificationDuTexte:=DT_RIGHT; 
    end; 
  
    // Si le texte est plus grand que notre zone, on prend cette précaution (Clipping) 
    with ARect do MyRgn :=CreateRectRgn(Left,Top,Right,Bottom); 
    SelectClipRgn(Handle,MyRgn); 
  
    // On dessine le texte 
    DrawText(Handle,PChar(AString),-1,Rect,JustificationDuTexte or DT_NOPREFIX or DT_WORDBREAK ); 
  
    // On a plus besoin de la zone de clipping 
    SelectClipRgn(Handle,0); 
    DeleteObject(MyRgn); 
    Unlock; 
  end; 
end;
Utilisation de la procédure DessineTexteMultiligne :
  • AString: string;
    Chaîne de caractère à dessiner.

  • ACanvas:TCanvas;
    Canvas où le texte doit être dessiné

  • ARect: TRect;
    Zone rectangulaire du Canvas dans laquelle le texte doit être dessiné

  • AlignementHorizontal:TAlignementHorizontal;
    Alignement Horizontal du texte dans la zone rectangulaire, trois options sont possibles :
    • alHLeft : Place le texte à gauche dans la zone rectangulaire.
    • alHCenter : Centre le texte horizontalement dans la zone rectangulaire.
    • alHRight : Place le texte à droite dans la zone rectangulaire.

  • AlignementVertical:TAlignementVertical;
    Alignement Vertical du texte dans la zone rectangulaire, trois options sont possibles :
    • alVTop : Place le texte en haut de la zone rectangulaire.
    • alVCenter : Centre le texte verticalement dans la zone rectangulaire.
    • alVBottom : Place le texte en bas de la zone rectangulaire.

  • TextJustification:TJustification
    Justification du texte
    • JustLeft : Justifie le texte à gauche
    • JustCenter : Justification centrée du texte
    • JustRight : Justifie le texte à droite


Note concernant le choix du type des paramètres de la procédure :
L'utilisation des types déjà existants de Delphi est tout aussi valable, à savoir :
  • AlignementVertical:TTextLayout;
  • AlignementHorizontal:TAlignement;
  • TextJustification:TAlignment;

Ces types sont déclarés dans les unités StdCtrls et Classes.

Mis à jour le 21 janvier 2014 LadyWasky

Nous vous proposons deux méthodes pour modifier le bouton par défaut d'un MessageDlg.

D'abord la première :

Code delphi : Sélectionner tout
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
function DefMessageDlg(const aCaption: string; const Msg: string; DlgType: TMsgDlgType; 
 Buttons: TMsgDlgButtons; DefButton: TModalResult; HelpCtx: Longint): Integer; 
// Crée une fenêtre de dialogue en précisant le bouton actif. 
// Exemple avec le bouton non par défaut 
// if DefMessageDlg('Voulez-vous le supprimer ?', mtConfirmation, mbYesNoCancel, mrno, 0) ... 
var 
 i: Integer; 
 btn: TButton; 
begin 
 with CreateMessageDialog(Msg, DlgType, Buttons) do 
 try 
   Caption := aCaption; 
   HelpContext := HelpCtx; 
   for i := 0 to ComponentCount - 1 do 
   begin 
     if Components[i] is TButton then 
     begin 
       btn := TButton(Components[i]); 
       btn.default := btn.ModalResult = DefButton; 
       if btn.default then 
         ActiveControl := Btn; 
     end; 
   end; 
   Result := ShowModal; 
 finally 
   Free; 
 end; 
end;
La seconde :
Code delphi : Sélectionner tout
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
function MsgEx(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefaultButton:TMsgDlgBtn):TModalresult; 
var phr:string; 
begin 
  if DefaultButton in Buttons then 
  begin 
      case DefaultButton of //On récupère le nom du bouton d'après son type 
        mbYes:phr:='Yes'; 
        mbNo:phr:='No'; 
        mbOK:phr:='OK'; 
        mbCancel:phr:='Cancel'; 
        mbAbort:phr:='Abort'; 
        mbRetry:phr:='Retry'; 
        mbIgnore:phr:='Ignore'; 
        mbAll:phr:='All'; 
        mbNoToAll:phr:='NoToAll'; 
        mbYesToAll:phr:='YesToAll'; 
        mbHelp:phr:='Help'; 
      end; 
      with CreateMessageDialog(Msg,DlgType,Buttons) do 
      try 
        activecontrol:=twincontrol(findcomponent(phr)); 
        result:=ShowModal; 
      finally 
        free; 
    end; 
  end else result:=Messagedlg(Msg,DlgType,Buttons,0); 
end;

Mis à jour le 21 janvier 2014 Laurent Dardenne Pedro

Parfois, il peut être intéressant, de pouvoir dupliquer non pas un contrôle mais plutôt l'image qu'il
restitue de lui même afin, par exemple, de l'imprimer ou de le sauvegarder dans un Bitmap.

Les deux types de contrôles qui restituent une image d'eux même sont les TWinControl et les TGraphicControl.

Les TWinControl possèdent une méthode PainTo() destinée à cet effet; par exemple ce code copie un TPanel et son contenu dans un Bitmap, puis le Bitmap est réutilisé pour être affiché dans la fiche principale :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
procedure WinControl_to_Bitmap(AWinControl:TWinControl;ABitmap:TBitmap); 
begin 
  ABitmap.Width:=AWinControl.Width; 
  ABitmap.Height:=AWinControl.Height; 
  AWinControl.PaintTo(ABitmap.Canvas,0,0); 
end; 
  
procedure TForm1.Button2Click(Sender: TObject); 
var ABitmap:TBitmap; 
begin 
  ABitmap:=TBitmap.Create; 
  WinControl_to_Bitmap(Panel1,ABitmap); 
  
  //utilisation du Bitmap 
  Form1.Canvas.Draw(0,0,ABitmap); 
  
  ABitmap.Free; 
end;
Pour les TGraphicControl, nous pouvons tirer partie du fait qu'ils possèdent tous un Canvas (propriété protégée) en utilisant la méthode CopyRect() de ce dernier (ce code copie un TShape dans un Bitmap) :
Code delphi : Sélectionner tout
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
type 
  // Pour rendre la propriété canvas publique voir FAQ  
  // Comment accéder aux Méthodes "Protected" d'une classe ? 
  // ici : http://delphi.developpez.com/faq/?page=Langage#Comment-acceder-aux-methodes-Protected-d-une-classe 
  // La méthode décrite dans la FAQ fonctionne aussi avec les propriétés 
  TPublicGraphicControl=class(TGraphicControl); 
  
procedure GraphicControl_to_Bitmap(AGraphicControl:TGraphicControl;ABitmap:TBitmap); 
begin 
  ABitmap.Width:=AGraphicControl.Width; 
  ABitmap.Height:=AGraphicControl.Height; 
  ABitmap.Canvas.CopyRect(ABitmap.Canvas.ClipRect,TPublicGraphicControl(AGraphicControl).Canvas, 
                          AGraphicControl.ClientRect); 
end; 
  
procedure TForm1.Button3Click(Sender: TObject); 
var ABitmap:TBitmap; 
begin 
  ABitmap:=TBitmap.Create; 
  GraphicControl_to_Bitmap(Shape1,ABitmap); 
  
  //utilisation du Bitmap 
  Form1.Canvas.Draw(0,0,ABitmap); 
  
  ABitmap.Free; 
end;
Enfin, nous pouvons combiner les deux techniques décrites ci-dessus afin de réaliser une procédure un peu plus générique en sachant que TWinControl et TGraphicControl dérivent toutes les deux de la classe TControl :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
procedure Control_to_Bitmap(AControl:TControl;ABitmap:TBitmap); 
begin 
  if (AControl is TWinControl) then WinControl_to_Bitmap((AControl as TWinControl),ABitmap); 
  if (AControl is TGraphicControl) then GraphicControl_to_Bitmap((AControl as TGraphicControl),ABitmap); 
end; 
  
procedure TForm1.Button4Click(Sender: TObject); 
var ABitmap:TBitmap; 
begin 
  ABitmap:=TBitmap.Create; 
  
  // Copie du Panel dans le Bitmap 
  Control_to_Bitmap(Panel1,ABitmap); 
  
  // Utilisation du premier Duplicata (celui du TPanel et de son contenu) 
  Form1.Canvas.Draw(0,0,ABitmap); 
  
  // Copie du Panel dans le Bitmap 
  Control_to_Bitmap(Shape1,ABitmap); 
  
  // Utilisation du deuxième Duplicata (celui du TShape et de son contenu) 
  Form1.Canvas.Draw(0,0,ABitmap); 
  ABitmap.Free; 
end;

Mis à jour le 21 janvier 2014 LadyWasky

Lors de l'appui sur la touche Apps sur un StringGrid ou un DBGrid, le menu contextuel n'apparaît pas sur la cellule sélectionnée, mais au coin supérieur gauche du composant, voici une solution qui permet d'afficher le menu contextuel à la bonne position.

Dans la section Private ou Public (il faut que pt soit une variable globale) on ajoute

Code delphi : Sélectionner tout
Pt : TPoint ;
On utilise l'évènement OnDrawCell du StringGrid ( OnDrawColumnCell du DBGrid) et on procède comme suit:
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
    Rect: TRect; State: TGridDrawState); 
  begin 
    if gdSelected in State then 
    begin 
      Pt.X := Rect.Left; 
      Pt.Y := Rect.Top; 
    end; 
  end;
Ou
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; 
    DataCol: Integer; Column: TColumn; State: TGridDrawState); 
  begin 
    if gdSelected in State then 
    begin 
      Pt.X := Rect.Left; 
      Pt.Y := Rect.Top; 
    end; 
  end;
Et bien sûr, l'événement OnKeyUp (Commun aux deux composants)
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
procedure TForm1.StringGrid1KeyUp(Sender: TObject; var Key: Word; 
    Shift: TShiftState); 
  begin 
    if Key = VK_Apps then 
      with TCustomGrid(Sender).ClientToScreen(Pt) do 
        PopupMenu1.Popup(X + 4, Y + 4); 
  end;
et c'est tout.

Mis à jour le 21 janvier 2014 delphichem

Lors de la conception et d'une insertion d'objet dans un conteneur, la méthode InsertControl est appelée. Toutefois, cette méthode n'est pas surchargeable. Il faut donc utiliser la méthode prévue pour cela: ValidateInsert.
Pour interdire l'insertion d'un composant, il suffit de lever une exception dans cette méthode.

Exemple d'une classe héritant de TCustomPanel (ancêtre direct de TPanel) n'acceptant que les TButton.

Interface

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
type 
  TUneClasse = class(TCustomPanel) 
  private 
    { Déclarations privées } 
  protected 
    { Déclarations protégées } 
  public 
    { Déclarations publiques } 
    procedure ValidateInsert(AComponent: TComponent); override; 
  published 
    { Déclarations publiées } 
  end;
Implementation
Code delphi : Sélectionner tout
1
2
3
4
5
procedure TUneClasse.ValidateInsert(AComponent: TComponent); 
begin 
  if not (AComponent is TButton) then 
    Raise Exception.Create('Ce contrôle n''est pas un TButton. Insertion annulée'); 
end;

Mis à jour le 21 janvier 2014 Herk77

Normalement, la modification de la couleur d'un TButton standard est quasi-impossible.
La méthode proposée ici est basée sur la dérivation de la méthode WindowProc du bouton afin de gérer les messages de dessin.

Une fiche et un TButton dessus, et ce code :

Code delphi : Sélectionner tout
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
unit Unit1; 
  
 interface 
  
 uses 
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
   Dialogs, StdCtrls, ExtDlgs, ExtCtrls; 
  
 type 
   TForm1 = class(TForm) 
     Button1: TButton; 
     procedure FormCreate(Sender: TObject); 
     procedure Button1Click(Sender: TObject); 
   private 
     { Déclarations privées } 
     oldBtnProc : TWndMethod; 
     Procedure MyBtnWndProc( Var msg : TMessage ); 
   public 
     { Déclarations publiques }      
   end; 
  
 var 
   Form1: TForm1; 
  
 implementation 
  
 {$R *.dfm} 
 procedure TForm1.FormCreate(Sender: TObject); 
 begin 
   // Sauvegarde la WndProc actuelle du bouton 
   oldBtnProc := Button1.WindowProc; 
   // Affecte une nouvelle procédure de fenêtre. 
   Button1.WindowProc := MyBtnWndProc; 
 end; 
  
 procedure TForm1.Button1Click(Sender: TObject); 
 begin 
   ShowMessage('Coucou !'); 
 end; 
  
 procedure TForm1.MyBtnWndProc(var msg: TMessage); 
 Var hdcBtn : HDC; 
     btnCanvas : TControlCanvas; 
     i,j:Integer; 
     AColor,OldColor:TColor; 
 Begin 
   OldBtnProc(msg); 
   If (msg.Msg = BM_SETSTATE) Or (msg.Msg = WM_PAINT) Or (msg.Msg = WM_NCPAINT) Then 
   Begin 
     btnCanvas := TControlCanvas.Create;   
     Try       
       btnCanvas.Control:=Button1; 
       OldColor:=TColor(GetTextColor(btnCanvas.Handle));  
       for i:=2 to Button1.ClientWidth-3 do 
         for j:=2 to Button1.ClientHeight-3 do 
         begin 
           AColor:=btnCanvas.Pixels[i,j]; 
           if AColor<>OldColor 
           then btnCanvas.Pixels[i,j]:=clyellow; 
         end; 
     Finally 
       btnCanvas.Free; 
     End; 
   End; 
 End; 
  
 end.
Notes pratiques :
  • Cette méthode fonctionne aussi bien sans qu'avec les thèmes Windows XP (thème du bouton et des autres controles activés par TXPManifest par exemple)
  • Vous pouvez améliorer les performances du code du dessin en passant par un bitmap intermédiaire et utiliser sa propriété scanline.
  • Vous pouvez en fait modifier non seulement la couleur du bouton mais, bien mieux, le personnaliser à loisir (image de fond, dégradé, etc.).

Voici à titre d'exemple (non commenté) une version fortement améliorée reprenant le principe et ces suggestions (Une fiche, un TButton, et un TXPManifest) :
Code delphi : Sélectionner tout
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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
unit Unit1; 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, XPMan; 
  
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    XPManifest1: TXPManifest; 
    procedure FormCreate(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
  private 
    { Déclarations privées } 
    oldBtnProc : TWndMethod; 
    Procedure MyBtnWndProc( Var msg : TMessage ); 
   public 
     { Déclarations publiques } 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
  
{$R *.dfm} 
type 
   pRGBTripleArray = ^TRGBTripleArray; 
   TRGBTripleArray = array [0 .. 65535] of TRGBTriple; 
   TColorMatch=(cmEqual,cmDifferent); 
  
procedure ChangeColor(Source: TBitmap; const OldColor,NewColor: TColor;ColorMatch:TColorMatch;TransparencePourcent:integer); 
var 
      I, J: Integer; 
      P: pRGBTripleArray; 
      R1, G1, B1: Integer; 
      R2, G2, B2: Integer; 
      R3, G3, B3: Integer; 
      CL1,CL2:Integer; 
      egal:boolean; 
      p1,p2:single; 
begin 
      if ((TransparencePourcent<0) or (TransparencePourcent>100)) then exit; 
      Source.PixelFormat := pf24bit; 
      CL1:=ColorToRGB(OldColor); 
      CL2:=ColorToRGB(NewColor); 
      R1 := GetRValue(CL1); 
      G1 := GetGValue(CL1); 
      B1 := GetBValue(CL1); 
      R2 := GetRValue(CL2); 
      G2 := GetGValue(CL2); 
      B2 := GetBValue(CL2); 
      p1:=TransparencePourcent/100; 
      p2:=1-p1; 
      for J := 0 to Source.Height - 1 do 
      begin 
        P := Source.ScanLine[J]; 
        for I := 0 to Source.Width - 1 do 
        begin 
          R3 := P[i].rgbtRed; 
          G3 := P[i].rgbtGreen; 
          B3 := P[i].rgbtBlue; 
          egal:=((P[i].rgbtRed=R1) and (P[i].rgbtGreen=G1) and (P[i].rgbtBlue=B1)); 
          if (egal=(ColorMatch=cmequal)) then 
          begin 
            P[i].rgbtRed   := round(R2*p2+R3*p1); 
            P[i].rgbtGreen := round(G2*p2+G3*p1); 
            P[i].rgbtBlue  := round(B2*p2+B3*p1); 
          end; 
        end; 
      end; 
end; 
  
procedure TForm1.MyBtnWndProc(var msg: TMessage); 
 Var hdcBtn : HDC; 
     btnCanvas : TControlCanvas; 
     i,j:Integer; 
     AColor,OldColor:TColor; 
     ABitmap:TBitmap; 
     ARect:TRect; 
 Begin 
   OldBtnProc(msg); 
   If (msg.Msg = BM_SETSTATE) Or (msg.Msg = WM_PAINT) Or (msg.Msg = WM_NCPAINT) Then 
   Begin 
     btnCanvas := TControlCanvas.Create; 
     ABitmap:=TBitmap.Create; 
     Try 
       btnCanvas.Control:=Button1; 
       OldColor:=TColor(GetTextColor(btnCanvas.Handle)); 
  
       //copie du canvas dans le bitmap; 
       ABitmap.Width:=Button1.ClientWidth; 
       ABitmap.Height:=Button1.ClientHeight; 
  
       ARect:=ABitmap.Canvas.ClipRect; 
       ABitmap.Canvas.CopyRect(ARect,btnCanvas,ARect); 
       ChangeColor(ABitmap,OldColor,clYellow,cmDifferent,50); 
       btnCanvas.CopyRect(ARect,ABitmap.Canvas,ARect); 
     Finally 
       btnCanvas.Free; 
       ABitmap.Free; 
     End; 
   End; 
 End; 
  
procedure TForm1.FormCreate(Sender: TObject); 
begin 
   // Sauvegarde la WndProc actuelle du bouton 
   oldBtnProc := Button1.WindowProc; 
   // Affecte une nouvelle procédure de fenêtre. 
   Button1.WindowProc := MyBtnWndProc; 
end; 
  
procedure TForm1.Button1Click(Sender: TObject); 
begin 
   ShowMessage('Coucou !'); 
end; 
  
end.

Mis à jour le 21 janvier 2014 LadyWasky

Écrire un texte qui plus est multiligne, bien centré dans une zone particulière d'un canvas, c'est bien, avec la possibilité d'un retour à la ligne automatique, c'est encore mieux !

La fonction suivante utilise une version améliorée de la fonction TextSize déjà décrite dans l'une des QR de notre FAQ :
Comment connaître la largeur et la hauteur en pixels d'un texte ?

Code delphi : Sélectionner tout
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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
interface 
... 
type 
  TAlignementVertical=(alVTop,alVCenter,alVBottom); 
  TAlignementHorizontal=(alHLeft,alHCenter,alHRight); 
  TJustification=(JustLeft,JustCenter,JustRight); 
  procedure DessineTexteMultiligne(AString: string;  
                       ACanvas:TCanvas;ARect: TRect; 
                       AlignementHorizontal:TAlignementHorizontal; 
                       AlignementVertical:TAlignementVertical; 
                       TextJustification:TJustification; 
                       WordWrap:boolean); 
... 
implementation 
  
///La valeur du paramètre AWidth détermine si on effectue un retour 
//à la ligne automatique ou non : 
//    - avec AWidth=0 => pas de WordWrap 
//    - avec AWidth<>0 => WorWrap sur la largeur donnée 
Function TextSize2(Phrase: string; AWidth: integer; Police: TFont = nil): TPoint; 
var 
  DC: HDC; 
  X: Integer; 
  Rect: TRect; 
  C : TBitmap; 
  WordWrapParams:integer; 
begin 
  C := TBitmap.create; 
  if police <> nil then  C.canvas.Font := police; 
  
  Rect.Left := 0; 
  Rect.Top:=0; 
  Rect.Right:=AWidth; 
  Rect.Bottom:=0; 
  DC := GetDC(0); 
  C.Canvas.Handle := DC; 
  
  WordWrapParams:=0; 
  if AWidth<>0 then WordWrapParams:=DT_NOPREFIX or DT_WORDBREAK; 
  
  DrawText(C.Canvas.Handle, PChar(Phrase), -1, Rect, WordWrapParams or (DT_EXPANDTABS or DT_CALCRECT)); 
  C.Canvas.Handle := 0; 
  ReleaseDC(0, DC); 
  Result.X:=Rect.Right-Rect.Left; 
  Result.Y:=Rect.Bottom-Rect.Top; 
  C.Free; 
end; 
  
//Notre procedure d'affichage de texte multiligne 
function DessineTexteMultiligne(AString: string;ACanvas:TCanvas;ARect: TRect; 
                       AlignementHorizontal:TAlignementHorizontal; 
                       AlignementVertical:TAlignementVertical; 
                       TextJustification:TJustification; 
                       WordWrap:boolean):TRect; 
var 
  AHeight,AWidth:integer; 
  Rect,oldClipRect:TRect; 
  ATop,ALeft,H,W:Integer; 
  AText:string; 
  JustificationDuTexte:Integer; 
  APoint:TPoint; 
begin 
  with ACanvas do 
  begin 
    Lock; 
    AHeight:=ARect.Bottom-ARect.Top; 
    AWidth:=ARect.Right-ARect.Left; 
    //on calcule la taille du rectangle dans lequel va tenir le texte (sans WordWrap) 
    APoint:=TextSize2(AString,0,ACanvas.Font); 
    W:=APoint.X; 
    H:=APoint.Y; 
  
    //on calcule la position (Haut,Gauche) du rectangle dans lequel va tenir le texte 
    //en fonction de l'alignement horizontal et vertical choisi 
    ATop:=ARect.Top; 
    ALeft:=ARect.Left; 
  
    If WordWrap then //Si on veut un "WordWrap" (retour à la ligne automatique) 
      if W>(ARect.Right-ARect.Left) then //et que le texte dépasse du rectangle de destination 
      begin //alors... 
        W:=(ARect.Right-ARect.Left); //on fixe la largeur du texte 
        H:=TextSize2(AString,W,ACanvas.Font).y; //on recalcule la hauteur du texte 
      end; 
  
    case AlignementVertical of 
      alVBottom : ATop:=ARect.Bottom-H; 
      alVCenter : ATop:=ARect.Top+((AHeight-H) div 2); 
      alVTop    : ATop:=ARect.Top; 
    end; 
  
    case AlignementHorizontal of 
      alHLeft  : ALeft:=ARect.Left; 
      alHCenter: ALeft:=ARect.Left+(AWidth-W) div 2; 
      alHRight : ALeft:=ARect.Right-W; 
    end; 
  
    //Fin du calcul du rectangle, on met le resultat dans Rect 
    Rect:=Bounds(ALeft,ATop,W,H); 
    //Si le texte est plus grand que notre zone, on prend cette précaution (Clipping) 
    IntersectRect(Rect,Rect,ARect); 
    //On détermine les paramètres de justification à passer à Windows 
    case TextJustification of 
      JustLeft  : JustificationDuTexte:=DT_LEFT; 
      JustCenter: JustificationDuTexte:=DT_CENTER; 
      JustRight : JustificationDuTexte:=DT_RIGHT; 
    end; 
  
  
    //On dessine le texte 
    DrawText(Handle,PChar(AString),-1,Rect,JustificationDuTexte or DT_NOPREFIX or DT_WORDBREAK ); 
  
    result:=Rect;     
    unlock; 
  end; 
end;
Utilisation de la fonction DessineTexteMultiligne :
Valeur renvoyée : c'est un rectangle qui correspond aux limites de la zone du canvas dans laquelle le texte à été effectivement dessiné.
  • AString: string; Chaîne de caractères à dessiner.
  • ACanvas: TCanvas; Canvas où le texte doit être dessiné
  • ARect: TRect; Zone rectangulaire du Canvas dans laquelle le texte doit être dessiné
  • AlignementHorizontal: TAlignementHorizontal; Alignement horizontal du texte dans la zone rectangulaire, trois options sont possibles :
    • alHLeft : Place le texte à gauche dans la zone rectangulaire.
    • alHCenter : Centre le texte horizontalement dans la zone rectangulaire.
    • alHRight : Place le texte à droite dans la zone rectangulaire.
  • AlignementVertical: TAlignementVertical; Alignement Vertical du texte dans la zone rectangulaire, trois options sont possibles :
    • alVTop : Place le texte en haut de la zone rectangulaire.
    • alVCenter : Centre le texte verticalement dans la zone rectangulaire.
    • alVBottom : Place le texte en bas de la zone rectangulaire.
  • TextJustification:TJustification : Justification du texte
    • JustLeft : Justifie le texte à gauche
    • JustCenter : Justification centrée du texte
    • JustRight : Justifie le texte à droite
  • WordWrap: boolean; Si on passe true, le texte est dessiné avec un retour à la ligne automatique

Note concernant le choix du type des paramètres de la procédure :
L'utilisation des types déjà existants de Delphi est tout aussi valable, à savoir :
  • AlignementVertical:TTextLayout;
  • AlignementHorizontal:TAlignement;
  • TextJustification:TAlignment;

Ces types sont déclarés dans les unités StdCtrls et Classes.

Mis à jour le 21 janvier 2014 LadyWasky

Pour déterminer si une Police de caractère est TrueType ou non, il s'agit d'utiliser l'API Windows GetTextMetrics.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
//unités à déclarer dans votre clause uses 
uses windows,Graphics; 
... 
function IsTrueTypeFont(NomPolice : string):boolean; 
var 
  Metrics: TTextMetric; 
  ACanvas : TCanvas; 
  DC:HDC; 
begin 
  ACanvas:=TCanvas.Create; 
  try 
    DC:=GetDC(HWND_DESKTOP); 
    ACanvas.Handle:=DC; 
    ACanvas.Font.Name:=NomPolice ; 
    GetTextMetrics(ACanvas.Handle, Metrics) ; 
    ReleaseDC(0,DC); 
    Result:=(Metrics.tmPitchAndFamily and TMPF_TRUETYPE) <> 0; 
  finally 
    ACanvas.free; 
  end;

Mis à jour le 21 janvier 2014 LadyWasky

Ci-dessous, une méthode générique qui permet de supprimer les doublons dans une liste de type TStrings utilisée dans les composants de type TListBox,TMemo, TComboBox, etc. On peut par ailleurs spécifier si l'on veut tenir compte de la casse ou pas.

L'idée de base est de se servir de la propriété Duplicates de TStringList, qui, positionnée à dupIgnore, ignore simplement l'ajout d'une chaîne déjà présente dans la liste. Comme ce test tient compte de la valeur de la propriété CaseSensitive, celle-ci sera également utilisée.

Ainsi, il suffit de créer une TStringList temporaire avec ces propriétés spécifiées correctement, puis d'y assigner le contenu de la liste de chaînes à traiter. Cela aura pour effet de n'y placer les chaînes qu'en un exemplaire maximum. Ensuite, il suffit de refaire l'assignation dans l'autre sens.

Dernière astuce, puisque le test répété de la présence ou non d'une chaîne dans la liste est coûteux en temps, on veut pouvoir l'optimiser. Pour cela, on utiliser une THashedStringList plutôt que TStringList, cette classe maintenant à jour une table de hashage des chaînes présentes dans la liste.

Le code résultant est donc le suivant :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure SupprimerDoublons(Strings : TStrings; CaseSensitive : boolean = True); 
var SL : THashedStringList; 
begin 
  SL := THashedStringList.Create; 
  try 
    SL.Duplicates := dupIgnore; 
    SL.CaseSensitive := CaseSensitive; 
    SL.Sorted := True; // Sinon Duplicates ne fait rien ! 
  
    SL.Capacity := Strings.Capacity;// Allocation du tableau une fois pour toutes 
    SL.AddStrings(Strings); 
  
    Strings.BeginUpdate(); 
    try 
      Strings.Clear(); 
      Strings.Capacity := SL.Capacity;// Allocation du tableau 
      Strings.AddStrings(SL); 
    finally 
      Strings.EndUpdate(); 
    end; 
    SL.Free; 
  end; 
end;
Remarque : l'usage de la classe THashedStringList requiert l'ajout de l'unité IniFiles dans les uses.

Mis à jour le 21 janvier 2014 Rayek sjrd

Les fonctions suivantes permettent d'obtenir la taille en pixels d'un texte dans un contrôle de la classe TWINControl, pour une police donnée.

Code delphi : Sélectionner tout
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
function GetTextSize  (const AControl : TWinControl; 
                       const AFont    : TFont; 
                       const AText    : string): TSize; 
var DC: HDC; 
begin 
  DC := GetWindowDC(AControl.Handle); 
  Result.cx := 0; 
  Result.cy := 0; 
  SelectObject(DC, AFont.Handle); 
  GetTextExtentPoint32(DC, PChar(AText), Length(AText), Result); 
  ReleaseDC(AControl.Handle, DC); 
end; 
  
function GetTextWidth (const AControl : TWinControl; 
                       const AFont    : TFont; 
                       const AText    : string): Integer; 
begin 
  Result := GetTextSize(AControl, AFont, AText).cx 
end; 
  
function GetTextHeight(const AControl : TWinControl; 
                       const AFont    : TFont; 
                       const AText    : string): Integer; 
begin 
  Result := GetTextSize(AControl, AFont, AText).cy 
end;


Mis à jour le 11 mars 2014 CapJack Roland Chastain

Le composant TForm dispose de ActiveControl, qui permet de savoir sur quel composant de la form est le focus.

Exemple :

Code Delphi : Sélectionner tout
1
2
// renvoie le nom du composant sur lequel il y a le focus. 
ShowMessage(maForm.ActiveControl.name);

Mis à jour le 10 avril 2014 Aos

Un CueBanner est un texte qui est affiché dans la zone de saisie d'un TEdit quand sa propriété Text est vide.
À partir de Delphi 2009 cette fonctionnalité est présente sous la forme d'une propriété nommée « TextHint ».
Mais on peut aussi obtenir le même résultat avec Delphi 7.
Dans tous les cas vous devez activer les Styles Windows, soit en déposant un TXPManifest sur la fiche, soit en choisissant, dans les options du projet, l'option « Activer les thèmes d'exécution ».

Pour une utilisation simple et directe :

Code : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
{ ================================================================== } 
const 
  EM_SETCUEBANNER             = $1501; 
  EM_GETCUEBANNER             = $1502; 
// n'oubliez pas de déposer un TXPManifest sur la fiche 
procedure TForm1.FormShow(Sender: TObject); 
var 
  Value: WideString; 
begin 
  Value := 'Entrez votre Texte ici'; 
  SendMessage(Edit1.Handle, EM_SETCUEBANNER, 1, LPARAM(Value)); 
end; 
{ ================================================================== }
Voici une deuxième solution réutilisable et compatible de D7 à Tokyo. L'intérêt de cette solution est d'avoir un code compatible avec toutes les versions de Delphi et de pouvoir éventuellement changer le comportement par défaut qui est que le champ s'efface dès que curseur y entre, au lieu de s'effacer à la première frappe, ce qu'il est possible d'obtenir en utilisant la procédure Edit_SetCueBannerTextFocused :

Code : Sélectionner tout
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
unit crCueBanner; 
 
interface 
uses Windows 
     {$if CompilerVersion < 20.00} 
       // à partir de D2009 vous devez activer les styles dans les options du projet 
     , XPMan 
     {$else} 
       // à partir de D2009 les fonctions "Edit_SetCueBannerText" & "Edit_GetCueBannerText" 
       // existent déjà. Nous les utiliserons par redirection. 
     , CommCtrl 
     {$ifend}; 
 
// https://msdn.microsoft.com/fr-fr/library/windows/desktop/bb761703(v=vs.85).aspx 
// fonction oubliée par Delphi permettant le choix ShowOnFocus: Boolean 
// qui permet ou non de voir le Cue Banner Text quand l'edit a le focus 
// active pour toutes les versions de Delphi 
function Edit_SetCueBannerTextFocused(hwnd: HWND; CueText: PWideChar; DrawFocused: Boolean = True): BOOL;{$if CompilerVersion >= 20.00} inline; {$ifend} 
 
 
{$if CompilerVersion < 20.00} 
//avant D2009 nous devons les déclarer et les implémenter 
function Edit_SetCueBannerText(hwnd: HWND; CueText: PWideChar): BOOL; 
function Edit_GetCueBannerText(hwnd: HWND; CueText: PWideChar; BufLen: Longint): BOOL; 
{$else} 
// comme elles existent depuis D2009 
type 
TEdit_SetCueBannerText = function (hwnd: HWND; CueText: PWideChar): BOOL; 
TEdit_GetCueBannerText = function (hwnd: HWND; CueText: PWideChar; BufLen: Longint): BOOL; 
 
// on va les utiliser 
var 
Edit_SetCueBannerText: TEdit_SetCueBannerText; 
Edit_GetCueBannerText: TEdit_GetCueBannerText; 
{$ifend} 
 
implementation 
const 
  EM_SETCUEBANNER             = $1501; 
  EM_GETCUEBANNER             = $1502; 
 
function Edit_SetCueBannerTextFocused(hwnd: HWND; CueText: PWideChar; DrawFocused: Boolean = True): BOOL;{$if CompilerVersion >= 20.00} inline; {$ifend} 
begin 
  Result := BOOL(SendMessage(hwnd, EM_SETCUEBANNER, wParam(DrawFocused), lParam(CueText))); 
end; 
{$if CompilerVersion < 20.00} 
function Edit_SetCueBannerText(hwnd: HWND; CueText: PWideChar): BOOL; 
begin 
  Result := BOOL(SendMessage(hwnd, EM_SETCUEBANNER, wParam(False), lParam(CueText))); 
end; 
 
function Edit_GetCueBannerText(hwnd: HWND; CueText: PWideChar; BufLen: Longint): BOOL; 
begin 
  Result := BOOL(SendMessage(hwnd, EM_GETCUEBANNER, wParam(CueText), lParam(BufLen))); 
end; 
{$else} 
initialization 
// redirige les fonctions existantes 
Edit_SetCueBannerText := @CommCtrl.Edit_SetCueBannerText; 
Edit_GetCueBannerText := @CommCtrl.Edit_GetCueBannerText; 
 
{$ifend} 
 
end.
Utilisation de Edit_SetCueBannerText :

Code : Sélectionner tout
1
2
3
4
5
6
7
{ ================================================================== } 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Edit_SetCueBannerText(Edit1.Handle, 'Entrez votre Texte ici'); 
  Edit_SetCueBannerText(Edit2.Handle, 'Votre nom'); 
end; 
{ ================================================================== }
Utilisation de Edit_GetCueBannerText :

Code : Sélectionner tout
1
2
3
4
5
6
7
8
9
{ ================================================================== } 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  aCueTxt: array[0..255] of WideChar; 
begin 
  if Edit_GetCueBannerText(Edit1.Handle, aCueTxt, 256) then 
    ShowMessage(aCueTxt); 
end; 
{ ================================================================== }
Utilisation de Edit_SetCueBannerTextFocused :

Code : Sélectionner tout
1
2
3
4
5
6
7
{ ================================================================== } 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Edit_SetCueBannerTextFocused(Edit1.Handle, 'Entrez votre Texte ici'); 
  Edit_SetCueBannerTextFocused(Edit2.Handle, 'Votre nom'); 
end; 
{ ================================================================== }
Merci à Roland Chastain, Charly910 et SergioMaster pour la correction et la mise en page

Mis à jour le 13 janvier 2018 Cirec

Proposer une nouvelle réponse sur la FAQ

Ce n'est pas l'endroit pour poser des questions, allez plutôt sur le forum de la rubrique pour ça


Réponse à la question

Liens sous la question
précédent sommaire suivant
 

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2024 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.