FENETRES
Messages postés196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 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és196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 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és196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 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és196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 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és196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 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és196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 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és2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 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és4297Date d'inscriptionsamedi 19 janvier 2002StatutMembreDernière intervention 9 janvier 201332 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és196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 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és4297Date d'inscriptionsamedi 19 janvier 2002StatutMembreDernière intervention 9 janvier 201332 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és196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 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).
PS : il serait superfétatoire de vous dire à quel point son auteur est apprécié et estimé.
Bacterius
Messages postés3792Date d'inscriptionsamedi 22 décembre 2007StatutMembreDernière intervention 3 juin 201610 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és196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 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és3792Date d'inscriptionsamedi 22 décembre 2007StatutMembreDernière intervention 3 juin 201610 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és196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 avril 2009 13 nov. 2008 à 16:00
Le contrôle TFilenameEdit est un composant RX en téléchargement libre.
yvessimon
Messages postés637Date d'inscriptionmardi 22 avril 2003StatutMembreDerniè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és196Date d'inscriptionjeudi 15 juillet 2004StatutMembreDernière intervention14 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és3792Date d'inscriptionsamedi 22 décembre 2007StatutMembreDernière intervention 3 juin 201610 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;
25 nov. 2008 à 11:46
--------------------------------------------------------
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;
--------------------------------------------------------
25 nov. 2008 à 10:14
--------------------------------------------------------------------
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
21 nov. 2008 à 10:31
Indispensable et simple à mettre en oeuvre, une vérification d'éventuelles fuites de mémoire devrait être systématique !
21 nov. 2008 à 10:14
« 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 !
20 nov. 2008 à 17:38
--------------------------------
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.
17 nov. 2008 à 12:50
Encore merci à tous
17 nov. 2008 à 11:09
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+
17 nov. 2008 à 09:37
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).
17 nov. 2008 à 09:16
16 nov. 2008 à 15:52
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."
13 nov. 2008 à 23:00
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é.
13 nov. 2008 à 21:00
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 !
13 nov. 2008 à 20:07
13 nov. 2008 à 18:36
Encore, si tu avais mis l'algorithme de formatage elliptique ... ça aurait pu donner lieu à une belle routine ;)
Cordialement, Bacterius !
13 nov. 2008 à 16:00
13 nov. 2008 à 15:48
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
13 nov. 2008 à 10:58
12 nov. 2008 à 18:31
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 !