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.
- Comment donner le focus à un composant ?
- Comment faire un retour à la ligne ?
- Comment aligner à droite le contenu d'un TControl (TEdit...) ?
- Comment ne rentrer que des chiffres dans un TEdit ?
- Comment modifier une propriété par son nom ?
- Comment réaliser un effet de scroll sur un label ?
- Comment convertir des coordonnées écran en position de caractère d'un contrôle d'édition ?
- Comment mettre une case à cocher dans un MessageDlg ?
- Pourquoi ai-je une erreur sur dsgnintf, en installant un composant sous Delphi 6 ou 7 ?
- Comment afficher des documents au format Adobe Acrobat (PDF) dans une application Delphi ?
- Comment effacer le contenu d'un TImage ?
- Comment parcourir les champs d'édition avec l'appui sur la touche "Enter" dans un formulaire ?
- Comment utiliser l'aide en ligne avec SynEdit ?
- Comment modifier le contenu d'un composant liste sans avoir de scintillement ?
- Comment cacher la barre de menu ?
- Comment vérifier l'égalité de deux images ?
- Comment simuler un lien hypertexte dans une fiche About ?
- Comment tracer dans un contrôle qui n'a pas de canvas ?
- Comment bloquer la saisie dans un Memo en Majuscule ?
- Comment appeler un évènement d'un composant ailleurs dans le code ?
- Comment avoir des couleurs dans un TMenuItem ?
- Comment animer le glyph d'un TMenuItem en fonction de son état (odSelected, etc) ?
- Comment avoir un TMainMenu dans un TPanel ?
- Comment dessiner sur le vrai Canvas d'un TImage sans modifier l'image qu'il contient (Picture) ?
- Comment dessiner un texte multiligne, correctement justifié et aligné dans une zone particulière d'un Canvas ?
- Comment modifier le bouton par défaut d'un MessageDlg ?
- Comment construire la représentation graphique d'un composant ?
- Comment bien positionner le menu contextuel d'une grille ?
- Comment n'accepter qu'un type de contrôle dans un objet ?
- Comment changer la couleur d'un TButton normal sans créer un descendant ?
- Comment dessiner un texte multiligne en WordWrap dans un Canvas ?
- Comment déterminer si une Police de caractères est TrueType ou non ?
- Comment supprimer les doublons d'une liste (TStrings) ?
- Obtenir la taille en pixels du texte d'un TWinControl
- Comment savoir quel composant a le focus ?
- Comment afficher un CueBanner ou PlaceHolder dans un TEdit ?
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; |
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).
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; |
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; |
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; |
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; |
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; |
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; |
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.
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; |
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; |
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.
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.
Les packages, par Merlin
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');
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.
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;
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; |
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; |
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; |
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;
Code delphi : | Sélectionner tout |
Self.Menu := MainMenu1;
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; |
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; |
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; |
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; |
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);
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;
Code delphi : | Sélectionner tout |
SetWindowLong(Memo1.Handle,GWL_STYLE,GetWindowLong(Memo1.Handle,GWL_STYLE)Or ES_UPPERCASE);
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; |
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');
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; |
Code delphi : | Sélectionner tout |
1 2 3 4 5 | var c:char; begin c:='p'; self.OnKeyPress(self, c); end; |
Code delphi : | Sélectionner tout |
FormKeyPress(nil,c);
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. |
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} ... |
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; |
Ces composants sont gratuits.
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. |
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; |
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.
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; |
- 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.
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; |
- 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.
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; |
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; |
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; |
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; |
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; |
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 ;
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; |
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; |
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; |
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; |
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; |
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. |
- 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. |
É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; |
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.
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; |
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; |
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; |
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); |
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; { ================================================================== } |
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. |
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; { ================================================================== } |
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; { ================================================================== } |
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; { ================================================================== } |
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 çaLes 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.