Sujet Précédent Sujet Suivant

DELPHI - CHEMIN D'ACCÈS DE STYLE ELLIPTIQUE (GET PATH ELLIPSIS)

Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 - 12 nov. 2008 à 18:31
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009 - 25 nov. 2008 à 11:46
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/48435-delphi-chemin-d-acces-de-style-elliptique-get-path-ellipsis
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
25 nov. 2008 à 11:46
Annule et remplace l'implémentation précédente (omission de la condition de libération du DC) :
--------------------------------------------------------
function GetPathEllipsis(ASender: TEdit; APath: string): string;
{ Retourne une expression elliptique du chemin d'accès }
var
DTParams: DrawTextParams;
PChr: PChar;
Rct: TRect;
begin
with DTParams do begin
cbSize:=SizeOf(DrawTextParams);
iLeftMargin:=1;
iRightMargin:=1;
end;
with TCanvas.Create do
try
Handle:=GetDC(ASender.Handle);
if (Handle<>0) and (APath<>EmptyStr) and (ASender.ClientWidth>0) then begin
PChr:=StrAlloc(Length(APath) + 5);
StrPCopy(PChr, APath);
Rct:=ASender.ClientRect;
Font:=ASender.Font;
if DrawTextEx(Handle, PChr, -1, Rct, DT_MODIFYSTRING Or DT_SINGLELINE or DT_PATH_ELLIPSIS, @DTParams) <> 0 then
Result:=PChr;
StrDispose(PChr);
end;
finally
if (handle<>0) then ReleaseDC(ASender.Handle, Handle);
Free;
end;
end;
--------------------------------------------------------
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
25 nov. 2008 à 10:14
Procédure équivalente avec l'API DrawTextEx (cf. ci-dessous) :
--------------------------------------------------------------------
function GetPathEllipsis(ASender: TEdit; APath: string): string;
{ Retourne une expression elliptique du chemin d'accès }
var
DTParams: DrawTextParams;
PChr: PChar;
Rct: TRect;
begin
with DTParams do begin
cbSize:=SizeOf(DrawTextParams);
iLeftMargin:=1;
iRightMargin:=1;
end;
with TCanvas.Create do
try
Handle:=GetDC(ASender.Handle);
Font:=ASender.Font;
if (Handle<>0) and (APath<>EmptyStr) and (ASender.ClientWidth>0) then begin
PChr:=StrAlloc(Length(APath) + 5);
StrPCopy(PChr, APath);
Rct:=ASender.ClientRect;
if DrawTextEx(Handle, PChr, -1, Rct, DT_MODIFYSTRING Or DT_SINGLELINE or DT_PATH_ELLIPSIS, @DTParams) <> 0 then
Result:=PChr;
StrDispose(PChr);
end;
finally
ReleaseDC(ASender.Handle, Handle);
Free;
end;
end;
--------------------------------------------------------------------
Min. required OS:
- DrawTex requires Windows NT 3.1 or later; Requires Windows 95 or later
- DrawTextEx requires Windows NT 4.0 or later; Requires Windows 95 or later
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
21 nov. 2008 à 10:31
Erratum, lire plutôt :
Indispensable et simple à mettre en oeuvre, une vérification d'éventuelles fuites de mémoire devrait être systématique !
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
21 nov. 2008 à 10:14
En remplacant l'instruction précédente par :
« ReportMemoryLeaksOnShutdown:=(DebugHook <> 0); » le gestionnaire de mémoire ne sera actif qu'en mode de débogage.
Indispensable parce que simple à mettre en oeuvre, cette vérification d'éventuels fuites de mémoire devrait être systématique !
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
20 nov. 2008 à 17:38
A propos, si quelqu'un continue à penser qu'il est possible de supprimer une instruction de libération dans le projet alors ajouter une vérification de la mémoire dans le fichier dpr comme ci-dessous :
--------------------------------
program Demo;

uses
Forms,
MainUnit in 'MainUnit.pas' {FrmDemo};

{$R *.res}

begin
ReportMemoryLeaksOnShutDown:=True;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TFrmDemo, FrmDemo);
Application.Run;
end.
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
17 nov. 2008 à 12:50
Compte tenu de l'approche algorithmique différente et pour rappel de la méthode Delphi, j'ai intégré ces deux méthodes pour comparaison dans la démo. D'autre part, j'ai utilisé l'API DraxText à la place de DraxTextEx pour améliorer la compatibilité Windows.

Encore merci à tous
cs_MAURICIO Messages postés 2106 Date d'inscription mardi 10 décembre 2002 Statut Modérateur Dernière intervention 15 décembre 2014 5
17 nov. 2008 à 11:09
Salut Fenetre,

on a tous fait un jour une fonction qui existatit déjà!
Comment on le sait? Grâce à DelphiProg :)

Bravo en tout cas pour cet essai.

A+
cs_Delphiprog Messages postés 4297 Date d'inscription samedi 19 janvier 2002 Statut Membre Dernière intervention 9 janvier 2013 32
17 nov. 2008 à 09:37
Ce n'est pas grave et tu as essayé de reproduire quelque chose dont tu ignorais l'existence, ce qui en soi est tout à fait louable.
J'ai signalé l'existence de cette fonction pour que les autres membres passant par ici en prennent connaissance également.
Juste une dernière précision : le type de données renvoyée (TFileName) ne doit pas laisser croire que l'usage de cette fonction est réservé aux noms de fichiers, puisque TFileName est déclaré comme "String" (c'est un alias).
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
17 nov. 2008 à 09:16
Merci pour l'info. DELPHIPROG et ... autant pour moi, je ne connaissais pas l'existence de cette fonction.
cs_Delphiprog Messages postés 4297 Date d'inscription samedi 19 janvier 2002 Statut Membre Dernière intervention 9 janvier 2013 32
16 nov. 2008 à 15:52
Delphi fournit déjà une fonction toute faite pour cela :
function MinimizeName(constFilename:TFileName;Canvas:TCanvas;MaxLen:Integer):TFileName;

déclarée dans FileCtrl.pas.
"Raccourcit un nom de chemin d'accès complet afin qu'il puisse être dessiné avec une longueur limite spécifiée."
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
13 nov. 2008 à 23:00
Pour information et pour conclure, en faisant une recherche sur code-source j'ai trouvé une source équivalente en VB (cf. lien ci-dessous).

http://www.vbfrance.com/codes/ELLIPSIS-COMMENT-TRONQUER-CHAINE-CARACTERES_40307.aspx

Cordialement,

PS : il serait superfétatoire de vous dire à quel point son auteur est apprécié et estimé.
Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 10
13 nov. 2008 à 21:00
Désolé si ma critique ne te plait pas, mais mettre une API, aussi puissante qu'elle soit, dans une source ne suffit pas.
Alors je reprends tes arguments :
Une source est toujours constructrice (et utile) lorsqu'elle est fondée (pas ici), argumentée (...), et utile (bon montrer une API peut toujours servir, c'est bon sur ce point).
Enfin bref, je ne vais pas discuter avec toi si tu ne veux pas comprendre ;)

Cordialement, Bacterius !
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
13 nov. 2008 à 20:07
Ne vous en déplaise, jeune homme, fondée et argumentée, une critique est toujours constructive sinon elle devient stérile.
Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 10
13 nov. 2008 à 18:36
Ce que j'essaye de te dire Fenêtres c'est que tu ne fais que nous montrer une API, avec un cocon de variables et de if..then autour.
Encore, si tu avais mis l'algorithme de formatage elliptique ... ça aurait pu donner lieu à une belle routine ;)

Cordialement, Bacterius !
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
13 nov. 2008 à 16:00
Le contrôle TFilenameEdit est un composant RX en téléchargement libre.
yvessimon Messages postés 637 Date d'inscription mardi 22 avril 2003 Statut Membre Dernière intervention 9 janvier 2017
13 nov. 2008 à 15:48
Bonjour,

j'ai le message Erreur
---------------------------
Le champ FrmDemo.FilenameEdit n'a pas de composant correspondant. Voulez-vous retirer la déclaration ?

Ou trouver FrmDemo.FilenameEdit ?

Saluttaions
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
13 nov. 2008 à 10:58
Si la vérification initiale est justifiée... pour le reste, les "simplifications" générent des erreurs.
Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 10
12 nov. 2008 à 18:31
Salut,
peut-être une petite vérification de pointeur au début, ou d'autres améliorations ... regarde :

___________________________


function GetPathEllipsis(ASender: TGraphicControl; APath: string): string;
{ Retourne une expression elliptique d'un emplacement }
var
PChr: PChar;
Rct: TRect;
begin
if not Assigned(ASender) then Exit; // Si référence ASender ne pointe sur rien, on s'en va rapidement ! (ou alors on crée ASender mais cela peut avoir des conséquences inattendues ...)
with TCanvas.Create do
try
Handle:=GetDC(ASender.Handle);
Font:=ASender.Font;
if (Handle<>0) and (APath<>EmptyStr) and (ASender.ClientWidth>0) then begin
PChr:=StrAlloc(Length(APath) + 5);
StrPCopy(PChr, APath);
Rct:=ASender.ClientRect;
if DrawTextEx(Handle, PChr, -1, Rct, DT_MODIFYSTRING Or DT_SINGLELINE or DT_PATH_ELLIPSIS, nil) <> 0 then
Result:=PChr;
end;
finally
ReleaseDC(ASender.Handle, Handle);
Free;
StrDispose(PChr);
end;
end;

C'est toujours utile.

J'ai mis TGraphicControl pour ASender, car seul TGraphicControl et ses enfants possèdent un canevas.

Sinon c'est un peu dommage de te servir de l'API DrawTextEx pour formater le texte intégral en texte elliptique ... en fait, toi tu ne fais qu'écrire sur le contrôle ASender.

En bref ton code pourrait se résumer à 1 ligne :'(
Regarde, si on condense un peu, et sans les vérifications ni les libérations :

function GetPathEllipsis(ASender: TEdit; APath: string): string;
{ Retourne une expression elliptique d'un emplacement }
var
Rct: TRect;
Res: PChar;
begin
with ASender.Canvas do
try
Font:=ASender.Font;
if (CHDC<>0) and (APath<>EmptyStr) and (ASender.ClientWidth>0) then begin
Rct:=ASender.ClientRect;
Res := PChar(APath);
if DrawTextEx(GetDC(Handle), Res, -1, Rct, DT_MODIFYSTRING Or DT_SINGLELINE or DT_PATH_ELLIPSIS, nil) <> 0 then
Result:=String(Res);
end;
end;
end;

Moche, hein ? Y'a ... pas grand chose ^^

Cordialement, Bacterius !

Discussions similaires

violation d'acces en delphi
anyaa -
Bacterius -

16 réponses
Passage d'objet par POST/GET
cs_TOURSENE -
TOURSENE -

4 réponses
comment configurer le include path ?
bzouli -
bzouli -

2 réponses
String.concat ou Path.Combine ?
winny68 -
coq -

17 réponses
Path.Combine et URL
SharpMao -
SharpMao -

8 réponses
Rejoignez-nous