Discussion :

[tourlourou]

Bonjour,

Je déclare une procédure dans la section interface de l'unité 2, qui est en uses de l'unité 1.

Sur la ligne d'un appel de cette procédure, l'IDE montre bien qu'elle est reconnue (procédure machin, unité 2), mais le compilateur bute avec le message "Error : identifier not found (nom de la procédure)"

Mais qu'est-ce que j'ai fait de mal ? Qui m'en veut ?

[Paul TOTH]

difficile à dire sans voir le code

[tourlourou]

Certes !

Mais Lazarus réserve quelques difficultés qui laissent pantois...

J'ai par exemple eu un souci -non résolu- avec ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
constructor TDepasseLabel.Create(var aLabel: TLabel; ALongColor: TColor; ADepasseMode: TDepasseMode);
begin
 inherited Create(ALabel.Owner);  
  //...
 aLabel:=self;
end;

qui plante ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
function TControl.GetText: TCaption;
var
  len: Integer;
begin
  // Check if GetTextBuf is overridden, otherwise
  // we can call RealGetText directly
  if TMethod(@Self.GetTextBuf).Code = Pointer(@TControl.GetTextBuf) // self = ????

Mais pour en revenir à nos moutons, voici le code déviant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
unit Unit1; 
 
{$Mode Delphi} // {$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, sqldb, db, BufDataset, memds, sqlite3conn, FileUtil, Forms,
  Controls, Graphics, Dialogs, StdCtrls, DBGrids,
  lyDepasseLabel in 'C:\Users\...\lyDepasseLabel.pas'; 
 
type
  TForm1 = class(TForm)  
    //....
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}       
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  ModifieLabelPourDepassement(Label1, clRed, dmEndPoints);
  // avec le curseur, l'IDE montre l'unité qui l'héberge
  // le compilo dit "identifier not found : ModifieLabelPourDepassement"
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
unit lyDepasseLabel;
 
{$Mode Delphi}
 
interface
 
uses
  StdCtrls, Graphics, Dialogs; 
 
type
 TDepasseMode=(dmBeginPoints, dmMiddlePoints, dmEndPoints);
 
procedure ModifieLabelPourDepassement(var aLabel: TLabel; aLongColor: TColor; aDepasseMode: TDepasseMode);
 
implementation             
 
//...

[chris37]

Bonjour,

As tu essayé de déclarer simplement lyDepasseLabel dans ta ligne de USES et d'ajouter 'C:\Users\...\lyDepasseLabel.pas' dans les options de compilation de ton projet ?

Cordialement,
Chris

[tourlourou]

Merci pour ton idée ; je viens de tester : c'est sans effet, sinon que l'IDE ne reconnaît plus la procédure...

Lazarus supporte-t-il les noms de répertoires avec des espaces ?

[chris37]

Hum

Essaye avec cette directive de compilation
{$mode objfpc}{$M+}
J'ai du modifier mes unités avec la dernière version de Lazarus

Toutes mes unités perso sont dans des dossiers autres que ceux de mes projets et j'ajoute uniquement le chemin dans les options de compilation du projet.

Si tu es sous Vista ou Seven ! il te faut les droits d'admin sur ces dossiers car il arrive que cela bloque notre guépard

Cordialement,
Chris

[droggo]

Jai,

D'autre part, j'ai un doute sur la validité de ton chemin

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  lyDepasseLabel in 'C:\Users\...\lyDepasseLabel.pas';

qui est un affichage "résumé", généralement pour éviter de déborder de l'affichage d'une fenêtre, MAIS, pour ton compilateur, il serait assez étonnant qu'il devine ce que \...\ signifie.

[tourlourou]

Le changement de directive entraîne un mieux, et pour le chemin, c'est moi qui l'ai raccourci pour vous éviter une lecture indigeste !

Merci à tous deux.

Je continue d'avoir l'autre problème(de VA) avec mon descendant de TLabel. Je ne suis pas sûr de continuer à caresser le guépard : je vais pê retourner dans le Grand Bleu, avec les dauphins...

[chris37]

De rien

Passe moi ton code de TLabel stp, je vais regarder ça !

J'ai lu ton autre post ! pourquoi ne recrees tu pas une classe dérivée pour cela ?

Cordialement,
Chris

[tourlourou]

Merci pour ton aide !

A la base, j'ai créé ce TDepasseLabel pour remplacer à l'exécution des TLabel posés sur une fiche, mais dont la longueur ne devait pas dépasser celle du design time.

D'où l'idée de créer ce descendant, qui affiche le texte incomplet suivi de '...' et le texte complet en hint.

Et pour faire plus "fun", de "remplacer" le Label par son descendant... au Free du Label initial, c'est son descendant qui est libéré et le libère lui-même (il est conservé pour la cuisine interne).

Certes, il y a d'autres méthodes pour gérer ça, mais ce code fonctionne parfaitement en Delphi 5, et son adaptation n'est malheureusement pas si évidente en FPC.

Voici donc l'unité :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
unit lyDepasseLabel;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  StdCtrls, Graphics;
 
type
 TDepasseMode=(dmBeginPoints, dmMiddlePoints, dmEndPoints);
 
type
 TDepasseLabel=class(TLabel)
 private
  FLabel: Tlabel;
  FMaxWidth: integer;
  FLongColor: TColor;
  FDepasseMode: TDepasseMode;
 public
  constructor Create(var ALabel: TLabel; ALongColor: TColor; ADepasseMode: TDepasseMode); overload;
  destructor Destroy; override;
  function GetLabelText: string; override;
 end;
 
implementation
 
// constructeur/remplaceur de l'objet ALabel passé en variable
constructor TDepasseLabel.Create(var ALabel: TLabel; ALongColor: TColor; ADepasseMode: TDepasseMode);
begin
 inherited Create(ALabel.Owner);           // crée un Tabel
 Parent:=ALabel.Parent;               // copie ses propriétés
 Top:=ALabel.Top;
 Left:=ALabel.Left;
 // on peut toutes les ajouter, selon besoins....
 Font.Name:=ALabel.Font.Name;
 Font.Size:=ALabel.Font.Size;
 Font.Pitch:=ALabel.Font.Pitch;
 Font.Style:=ALabel.Font.Style;
 FLabel:=ALabel;                           // garde le label en propriété et le cache
 Flabel.Visible:=False;                    // ajuste ses propriétés pour s'en servir
 FLabel.AutoSize:=True;
 FLongColor:=ALongColor;                   // ajuste ses propriétés propres
 FDepasseMode:=ADepasseMode;
 FMaxWidth:=FLabel.Width;
 Width:=ALabel.Width;
 ShowHint:=True;
 Caption:=ALabel.Caption;
 ALabel:=self;                             // remplace le label en renvoyant son adresse
end;
 
destructor TDepasseLabel.Destroy;
begin
 FLabel.Free;                              // supprime le label remplacé
 inherited;                                // libère l'objet
end;
 
// cette fonction est appelée lors de l'affichage du label
// c'est sa redéfinition qui permet l'effet voulu
function TDepasseLabel.GetLabelText: string;
var
 S: string;
begin
 FLabel.Caption:=Caption;             // colle le Caption dans le label initial (autosize)
 if FLabel.Width>FMaxWidth then begin      // selon la taille nécessaire,
  Hint:=Caption;                 // pour voir le texte entier en Hint
  Font.Color:=FLongColor;             // la couleur signale le dépassement
  case FDepasseMode of
   // à finir...
   dmBeginPoints  : begin end;
   dmMiddlePoints : begin end;
   dmEndPoints    : begin
                     while FLabel.Width>FMaxWidth do
                      FLabel.Caption:=Copy(FLabel.Caption,1,Length(FLabel.Caption)-1);
                      S:=Copy(FLabel.Caption,1,Length(FLabel.Caption)-3)+'...';
                    end;
 
  end;
  Result:=S;
 end
 else begin
  Font.Color:=FLabel.Font.Color;      // couleur d'origine
  Hint:='';                           // pas de Hint
  Result:=FLabel.Caption;                  // puisque le texte entier tient
 end;
end;
 
end.

[Paul TOTH]

c'est très surprenant comme façon de faire.

voici deux astuces qui peuvent te servir

1) surcharger un composant standard :

si dans ta fiche tu déclares un nouvelle classe TLabel, elle sera utilisée en lieu est place du TLabel standard, tu peux même dérivé de l'original

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
unit unit1;
...
type
  TLabel = class(StdCtrls.TLabel)
   ...
  end;
 
  TForm1 = class(TForm)
  ...
   Label1: TLabel; // la classe ci-dessus
  ...
  end;

tu peux aussi mettre cette déclaration dans une unité pour peu qu'elle soit placée APRES StdCtrls dans le uses de la fiche.

2) la fonction DrawText de l'API Windows propose l'ajout automatique des "..." avec le flag DT_END_ELLIPSIS.

Avec ces deux éléments, il te suffit donc de surcharger le Paint ou DoDrawText de TLabel pour obtenir l'effet désiré.

[tourlourou]

@Paul Toth : cette façon de faire m'amusait (on s'amuse comme on peut !) et je ne savais pê pas faire autrement au moment où j'ai commis ça...

D'accord pour la solution avec DrawText, mais ce qui me chagrine aujourd'hui n'est pas tant la manière que la difficulté de porter un code sous FPC. J'ai commencé à porter qq unités d'un projet sur lequel je suis bloqué par un Delphi 5 sous W98, espérant que Lazarus me permettrait de lever les limitations. Mais je ne m'attendais pas à tant de difficultés, en butant sur des détails, alors que je pensais seulement me faire la main en adaptant ces codes, et non les refondre (même si on peut faire mieux...) Ca fait un peu peur avant de s'attaquer au vif du sujet !

NB : j'aime beaucoup la redéclaration de type, que tu as déjà proposée dans des cas similaires.