Pb sur une image dans un Hint

Version imprimable

Voir 40 message(s) de cette discussion en une page

29/11/2011, 12h50
cincap

@ Gilbert Geyer, en effet, car dans mon application j'utilise le composant "sHintManager" de la Vcl AlphaSkins qui permet de faire des Hints avec effet (bulle, dégradés ect...).

Ta solution, permet de réaliser un vrai hint avec image mais semble neutraliser ce composant car sur les Tbutton sans image, le hint est standard donc sans tenir compte du composant dans le "uses".

Dans une application standard, ce composant applique des effets sur tous les Hints.

@+,

Cincap

Re-bonjour,

Tiens voici un autre truc, pour mettre à jour un Hint en continu pour y afficher l'heure par exemple et en prime ça permet de supprimer les procédures SpeedButton1MouseMove et FormMouseMove :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
procedure TForm1.DoShowHint( var HintStr: String ; var CanShow: Boolean;
                             var HintInfo: THintInfo);
begin     if HintInfo.HintControl = Label1 then begin // Hint du Label1 mis à jour périodiquement :
             Tagada:=1;
             HintInfo.HintColor:=clAqua;
             HintInfo.ReshowTimeout := 100;           // Périodicité de la màj.
             Label1.Hint := TimeToStr( Time );        // Affiche l'heure ... par exemple.
          end else
          if HintInfo.HintControl = SpeedButton1 then begin
             Tagada:=1;
          end else Tagada:=0;
end;

Pour faire fonctionner il suffit d'ajouter le ligne en vert-gras ci-dessous dans le FormCreate :

Code:

1
2
3
4
5
6
7
procedure TForm1.FormCreate(Sender: TObject);
begin     HintWindowClass := TMyHintWindow;
          ShowHint := true;
          Hint := '                                         Une image dans une info-bulle..';
          Application.OnShowHint := DoShowHint;
          Application.HintHidePause:=10000;
end;

... et d'ajouter dans les Déclarations privées de TForm 1 la déclaration de la procedure DoShowHint();

A+. :D

29/11/2011, 15h45
Gilbert Geyer

Re-bonjour,

Oups! Je n'avais pas remarqué ton message en page 2.

1) Tu dis "dans mon application j'utilise le composant "sHintManager" de la Vcl AlphaSkins qui permet de faire des Hints avec effet (bulle, dégradés ect...)".
... Ok, ça doit être joli.
... Mais je suppose que ce composant fait tout sauf un Hint avec Image sinon je pense que tu n'aurais ré-ouvert cette vielle discussion.

2) Tu dis "Ta solution, permet de réaliser un vrai hint avec image mais semble neutraliser ce composant car sur les Tbutton sans image, le hint est standard donc sans tenir compte du composant dans le "uses"".
... Cela semble normal qu'il ne tienne pas compte du composant qui doit certainement être du genre THintManager = class(THintWindow) et comme ma solution c'est également du TMyHintWindow = class(THintWindow) c'est donc la dernière surcharge de THintWindow qui est prise en compte.

A+. :D

Hello,

@ Gilbert Geyer, décidemment tu n'es pas à court de ressource !

Citation:

Mais je suppose que ce composant fait tout sauf un Hint avec Image sinon je pense que tu n'aurais ré-ouvert cette vielle discussion.

Si sous forme de texture donc pas en entier comme ta solution sans composant :ccool:.

Dans ton exemple, le TspeedButton1 se nomme dans mon test "B1".

J'ai du donc pour afficher l'image au survol de "B1" inverser la valeur de tagada :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 procedure TForm1.DoShowHint( var HintStr: String ; var CanShow: Boolean; var HintInfo: THintInfo); begin if HintInfo.HintControl = Label1 then begin // Hint du Label1 mis à jour périodiquement : Tagada:=0; HintInfo.HintColor:=clAqua; HintInfo.ReshowTimeout := 100; // Périodicité de la màj. Label1.Hint := TimeToStr( Time ); // Affiche l'heure ... par exemple. end else if HintInfo.HintControl = B1 then begin Tagada:=0; end else Tagada:=1; end;
Et pour l'heure, elle ne s'affiche pas ainsi que la couleur à cause à mon avis (du thême !) sous Seven 64Bits.

Merci,

@+,

Cincap

30/11/2011, 12h18
Gilbert Geyer

Bonjour,

A Cincap :

1) Tu dis : Dans ton exemple, le TspeedButton1 se nomme dans mon test "B1".

Citation:

J'ai du donc pour afficher l'image au survol de "B1" inverser la valeur de tagada :

Et pour l'heure, elle ne s'affiche pas ainsi que la couleur à cause à mon avis (du thême !) sous Seven 64Bits.

... On dirait qu'il y a une embrouille :
- au survol de mon TspeedButton1 mon Hint s'affiche comme un Hint normal sans image,
- au survol de ma Form1 le Hint s'affiche avec une image,
- et au survol de mon Label1 le Hint s'affiche comme un Hint normal mais avec l'heure actualisée.
Bien entendu le ShowHint du label, de la form et du bouton sont à True.

2) Tu dis :

Citation:

décidemment tu n'es pas à court de ressource !

... Bin, si les Hint t'intéressent je peux te filer :
- mon code que j'ai aussi modifié afin d'afficher, en plus de l'image et de l'heure, une ombre style XP si XP est détecté.
- et un code un peu plus volumineux qui affiche un Hint semi-transparent, multi-ligne si besoins est, à coins arrondis, surmonté d'un triangle pointant vers le contrôle correspondant, et avec une ombre portée.

A+. :D
30/11/2011, 17h23
cincap

Bonsoir à toutes et à tous,

@ Gilbert Geyer :

Citation:

On dirait qu'il y a une embrouille

En effet, car pour mon cas c'était l'affichage de l'image sur le survol de B1 qui m'intéresse et qui est dans l'application le TButton de test d'envoi par Email, j'ai donc inverser la valeur mais tout fonctionne comme tu l'a présenté.

Pour le label c'est ok et c'est déjà un beau cours sur le Hint.

Cela m'intéresse d'autant que j'avais acheté les sources du composant "SHintManager" compris dans la vcl de chez Alpha et je peux aussi te les communiquer à titre d'information car il permet beaucoup de chôse comme l'ombre aussi !

@+,

Cincap

Bonjour,

A Cincap : Tu dis "Cela m'intéresse".

Voici déjà le code pour les hint's avec image, ou affichage de l'heure, avec ombre :

Code:

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, shellapi, Buttons;
 
type
  TForm1 = class(TForm)
  Label1: TLabel;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
    procedure DoShowHint( var HintStr: String ; var CanShow: Boolean;
                          var HintInfo: THintInfo);
  public
    { Déclarations publiques }
  end;
 
  TMyHintWindow = class(THintWindow)
  private
    ABitmap: TBitmap;
  protected
    procedure CreateParams(var Params: TCreateParams); override; //<- Pour l'ombre
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
var       Tagada : integer;
 
procedure TForm1.FormCreate(Sender: TObject);
begin     HintWindowClass := TMyHintWindow;
          ShowHint := true;
          Hint := '                          Une image dans une info-bulle..'; //<- Texte du Hint de Form1
          // avec suffisamment d'espaces au début pour échapper la zone réservée à l'image.
          Tagada:=0;
          Application.OnShowHint := DoShowHint;
          Application.HintHidePause:=10000;
end;
 
function  IsWinXP: Boolean; //<- Pour l'ombre
begin     Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and
          (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1);
end;
 
procedure TMyHintWindow.CreateParams(var Params: TCreateParams); //<- Pour l'ombre
const     CS_DROPSHADOW = $00020000;
begin     inherited;
          if IsWinXP
          then Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;
 
constructor TMyHintWindow.Create(AOwner: TComponent);
begin       inherited;
            ABitmap:= TBitmap.Create;
            try
              ABitmap.LoadFromFile('popo72x60.bmp');
              ABitmap.Transparent := true;
            except
              FreeAndNil(ABitmap);
            end;
end;
 
destructor TMyHintWindow.Destroy;
begin      ABitmap.Free;
           inherited;
end;
 
procedure TMyHintWindow.Paint;
var       DC: HDC;
          R: TRect;
 
begin     if Assigned(ABitmap) and (Tagada=0)
          then Canvas.Draw(1, 2, ABitmap); //<- Hint avec image
 
          inherited;
 
          DC := GetWindowDC(Handle);
          try
            if Tagada=0 then Height:=ABitmap.Height             //<- Hint avec image
                        else Height:=Canvas.TextHeight('H')+6;  //<- Hint normal sans image
            R := Rect(0, 0, Width, Height);
            DrawEdge(DC, R, EDGE_ETCHED , BF_RECT + BF_MONO);
          finally
            ReleaseDC(Handle, DC);
          end;
end;
 
procedure TForm1.DoShowHint( var HintStr: String ; var CanShow: Boolean;
                             var HintInfo: THintInfo);
begin     if HintInfo.HintControl = Label1 then begin // Hint du Label1 pour afficher l'heure en continu :
             Tagada:=1;
             HintInfo.HintColor:=clAqua;
             HintInfo.ReshowTimeout := 100;           // Périodicité de la màj.
             Label1.Hint := TimeToStr( Time );        // Affiche l'heure ... par exemple.
          end else
          if HintInfo.HintControl = SpeedButton1 then begin
             Tagada:=1;
          end else Tagada:=0;
end;
 
END.

Pour le code du Hint multi-lignes je pense faire un Zip si mon quota de pièces jointes n'est pas épuisé.

A+. :D

01/12/2011, 13h17
Gilbert Geyer

1 pièce(s) jointe(s)

Re-bonjour,

A Cincap : Et voici le Zip du code pour un Hint multi-lignes semi-transparent avec ombre mais sans image ... sauf si on le modifie en s'aidant du code de mon message précédent.

Espérons que mon quota de pièces-jointes n'est pas épuisé.

EDIT : Rendons à César ce qui appartient à César : Au départ ce code est de nono40 je l'ai simplement modifié pour ajouter la semi-transparence et l'ombre.
Par contre il est truffé de commentaires explicatifs intéressants.
01/12/2011, 17h53
cincap

1 pièce(s) jointe(s)

Bonsoir à toutes et à tous,

@ Gilbert, merci de toutes ces infos, j'avais déjà vu sur le forum une discution à propos de la transparence du hint et ou tu avais donné ta version que j'avais gardée.

ta dernière source (le zip) semble la même.

As tu envie de voir les sources du composant "HintManager" print screen en annexe.

@+,

Cincap
02/12/2011, 10h22
Gilbert Geyer

Bonjour,

A Cincap :

1)

Citation:

J'avais déjà vu sur le forum une discution à propos de la transparence du hint et ou tu avais donné ta version que j'avais gardée...ta dernière source (le zip) semble la même.

... Oups, je ne me souvenais plus que je l'avais déjà donnée.
... Comme je n'ai qu'un seul code pour le Hint semi-transparent c'est forcément le même sauf si entre-temps j'y ai modifié un détail ou deux.

2)

Citation:

As tu envie de voir les sources du composant "HintManager" print screen en annexe.

... Bin comme tu as dit :

Citation:

... j'avais acheté les sources du composant "SHintManager"

... Je pense qu'il serait imprudent de publier ici les sources d'un composant qu'il faut acheter.
... Mais rassure toi je me contente généralement de Hint's sobres non transparents et non bariolés car ces trucs ça embrouille la lisibilité, et pour laisser le temps de les lire j'augmente confortablement la valeur de HintHidePause d'autant plus que le Hint se cache dès que la souris est déplacée sur un autre élément.

A+. :D
02/12/2011, 14h22
cincap

Bonjour à toutes et à tous,

@ Gilbert Geyer,

Citation:

... Oups, je ne me souvenais plus que je l'avais déjà donnée.
... Comme je n'ai qu'un seul code pour le Hint semi-transparent c'est forcément le même sauf si entre-temps j'y ai modifié un détail ou deux.

J'ai retrouvé le lien et c'était Bruno13 qui avait aussi lancé le topic "Tpanel et transparence".

http://www.developpez.net/forums/d67...-transparence/

Sinon pour la source par MP.

Cordialement,

@+,

Cincap
02/12/2011, 14h40
Gilbert Geyer

Re-bonjour,

1)

Citation:

J'ai retrouvé le lien ...http://www.developpez.net/forums/d67...-transparence/

... Exact, Oui c'est le même code... sauf qu'il n'y a pas de ZIP.

2)

Citation:

Sinon pour la source par MP.

... OK, si tu veux. Et merci c'est juste par curiosité.

A+. :D

Bonjour à toutes et à tous,

Voici une autre façon de faire un Hint personnalisé sans interférence sur le composant Hint spécialisé.

Ajouter "Commctrl" dans le uses :

Code:

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 Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Commctrl, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  TTS_BALLOON    = $40;
  TTM_SETTITLE = (WM_USER + 32);

var
  hTooltip: Cardinal;
  ti: TToolInfo;
  buffer : array[0..255] of char;

procedure CreateToolTips(hWnd: Cardinal);
begin
  hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or TTS_BALLOON,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), hWnd, 0, hInstance, nil);
  if hToolTip <> 0 then
  begin
    SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
      SWP_NOSIZE or SWP_NOACTIVATE);
    ti.cbSize := SizeOf(TToolInfo);
    ti.uFlags := TTF_SUBCLASS;
    ti.hInst  := hInstance;
  end;
end;

procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;
  Text, Title: PChar);
var
  Item: THandle;
  Rect: TRect;
begin
  Item := hWnd;
  if (Item <> 0) and (GetClientRect(Item, Rect)) then
  begin
    lpti.hwnd := Item;
    lpti.Rect := Rect;
    lpti.lpszText := Text;
    SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti));
    FillChar(buffer, SizeOf(buffer), #0);
    lstrcpy(buffer, Title);
    if (IconType > 3) or (IconType < 0) then IconType := 0;
    SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer));
  end;
end;

{
IconType :

 0 - No icon
 1 - Information
 2 - Warning
 3 - Error
}

procedure TForm1.Button1Click(Sender: TObject);
begin
 CreateToolTips(Form1.Handle);
  AddToolTip(Memo1.Handle, @ti, 1, 'Alors qu''en penses tu ?', 'Hello');
//Memo1 ou Button1 ect.....
end;

end.

@+,

Cincap

Bonjour,

Tu dis :

Citation:

Ajouter "Commctrl" dans le uses :

... Il y a apparemment autre chose à ajouter quelque part car quand je fais ceci :
Code:

1 2 3 4 5 6 procedure TForm1.Button1Click(Sender: TObject); begin CreateToolTips(Form1.Handle); AddToolTip(Memo1.Handle, @ti, 1, '1 = Information Alors qu''en penses tu ?', 'Hello'); AddToolTip(Button1.Handle, @ti, 3, '3 = Error Alors qu''en penses tu ?', 'Hello'); //Memo1 ou Button1 ect..... end;
... bin dans ce cas l'icône "Error" affectée à Button1 apparaît également lors du survol du Memo1 auquel j'avais affecté l'icône "Information".

Mis à part ce point la solution est relativement simple, sauf que je ne vois pas comment remplacer les icônes par des images un peu plus grandes.

A+. :D

Bonsoir à toutes et à tous,

@ Gilbert Geyer, en effet il n'y a qu'ajouter "Commctrl" dans le uses.

Pourquoi rajouter le n° d'icon dans le texte puisqu'il est référencié avant !

Pour que cela fonctionne pour chaque objet un hint personnalisé, il faut l'utiliser comme ceci :

Code:

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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Commctrl, StdCtrls, sHintManager;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    sHintManager1: TsHintManager;
    Button2: TButton;
    procedure FormShow(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
const
  TTS_BALLOON    = $40;
  TTM_SETTITLE = (WM_USER + 32);
 
var
  hTooltip: Cardinal;
  ti: TToolInfo;
  buffer : array[0..255] of char;
 
procedure CreateToolTips(hWnd: Cardinal);
begin
  hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or TTS_BALLOON,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), hWnd, 0, hInstance, nil);
  if hToolTip <> 0 then
  begin
    SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
      SWP_NOSIZE or SWP_NOACTIVATE);
    ti.cbSize := SizeOf(TToolInfo);
    ti.uFlags := TTF_SUBCLASS;
    ti.hInst  := hInstance;
  end;
end;
 
procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;
  Title: PChar; Text : String);   //Text : Pchar et String pour TMemo
var
  Item: THandle;
  Rect: TRect;
begin
  Item := hWnd;
  if (Item <> 0) and (GetClientRect(Item, Rect)) then
  begin
    lpti.hwnd := Item;
    lpti.Rect := Rect;
    lpti.lpszText := pchar(Text); //lpti.lpszText :=Text;
    SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti));
    FillChar(buffer, SizeOf(buffer), #0);
    lstrcpy(buffer, Title);
 
    if (IconType > 3) or (IconType < 0) then IconType := 0;
    SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer));
  end;
  end;
 
{
IconType :
 
 0 - No icon
 1 - Information
 2 - Warning
 3 - Error
}
 
 
procedure TForm1.FormShow(Sender: TObject);
begin
  CreateToolTips(Memo1.Handle);
  AddToolTip(Memo1.Handle, @ti, 1, '1=Alors qu''en penses tu ?', Memo1.text);
 
  CreateToolTips(button2.Handle);
  AddToolTip(button2.Handle, @ti, 3, '3=Alors qu''en penses tu ?', 'Titre');
 
  CreateToolTips(Form1.Handle);
  AddToolTip(Form1.Handle, @ti, 2, '2=Alors qu''en penses tu ?', 'Titre');
end;
 
end.

Le composant HintManager n'est pas bloqué !

Pour l'image, peut être en remaniant la procédure mais déjà beaucoup de solution existe, alors.....

@+,

Cincap

Bonjour,

1)

Citation:

Pourquoi rajouter le n° d'icon dans le texte puisqu'il est référencié avant !

... c'était juste pour créer une correspondance visuelle.

2)

Citation:

Pour que cela fonctionne pour chaque objet un hint personnalisé, il faut l'utiliser comme ceci :

... Ok, merci, c'est effectivement mieux : les icônes sont bien différenciées.

Par contre, je n'ai pas réussi à obtenir un hint multi-Lignes avec le AddToolTip(... Memo1.text) : voir commentaires dans le code c-dessous :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 procedure TForm1.FormShow(Sender: TObject); begin CreateToolTips(Memo1.Handle); //AddToolTip(Memo1.Handle, @ti, 1, '1=Alors qu''en penses tu ?', Memo1.text); // < [Erreur] ... : Types incompatibles : 'TCaption' et 'PChar' AddToolTip(Memo1.Handle, @ti, 1, '1=Alors qu''en penses tu ?', 'Ligne1'+#13#10+'Ligne2'+#13#10+'etc'); // Multi-Lignes : ne marche pas AddToolTip(Memo1.Handle, @ti, 1, '1=Alors qu''en penses tu ?', PChar(Memo1.text)); // Multi-Lignes : ne marche pas non-plus CreateToolTips(button2.Handle); AddToolTip(button2.Handle, @ti, 3, '3=Alors qu''en penses tu ?', 'Bouton2'); CreateToolTips(Form1.Handle); AddToolTip(Form1.Handle, @ti, 2, '2=Alors qu''en penses tu ?', 'Form1'); end;
3)

Citation:

Le composant HintManager n'est pas bloqué !

... Suggestion : Dans ton dernier code il aurait été préférable d'ajouter une commentaire similaire à celui-ci :
Code:

1 2 3 4 5 type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; //sHintManager1: TsHintManager; //<- Composant facultatif
... pour la simple raison que ton code qui est simple marche au moins dans le cas de Hint's à une seule ligne de texte et ça évite d'avoir à utiliser l'usine à gaz de sHintManager.

4)

Code:

Pour l'image, peut être en remaniant la procédure mais déjà beaucoup de solution existe, alors.....

... bin pendant qu'on était sur ce sujet c'était l'occasion de chercher des trucs simples mais répondant à un max de besoins, mais on peut considérer que le code qui permet d'insérer une image dans un Hint est lui-aussi relativement simple.

A+. :D

06/12/2011, 12h46
cincap
@ Gilbert Geyer,

Citation:

//AddToolTip(Memo1.Handle, @ti, 1, '1=Alors qu''en penses tu ?', Memo1.text); // < [Erreur] ... : Types incompatibles : 'TCaption' et 'PChar'

As tu vérifié la modification de la procédure "AddToolTip", il faut enlever Text de Pchar et rajouter Text : String pour un TMemo :
Code:

1 2 3 4 5 procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer; Title: PChar; Text : String); //Text : Pchar ou Text : String pour un TMemo var .......
Après rien que ce code reproduit l'icone et le texte du TMemo dans le Hint :
Code:

1 2 3 4 5 procedure TForm1.FormShow(Sender: TObject); begin CreateToolTips(Memo1.Handle); AddToolTip(Memo1.Handle, @ti, 1, '1=Alors qu''en penses tu ?', Memo1.text);
Mon dernier code fonctionne correctement sous D6 et Seven 64 Bits.

Edit pour le cas de non utilisation d'un TMemo, et quand même avoir dans le Hint plusieures lignes, c'est à la dernière tranche que le texte est pris en compte, avant c'est le titre du Hint donc :

Après avoir modifié la procédure pour uniquement le texte :
Code:

1 2 3 procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer; Title, Texte: PChar); //Text : Pchar ou Text : String pour un TMemo
La partie ecrite "Hello" est le titre, l'autre partie est le texte du Hint
Code:

1 2 3 CreateToolTips(Form1.Handle); AddToolTip(Form1.Handle, @ti, 2, '2= Hello', 'Ligne1'+#13#10+'Ligne2'+#13#10+'etc');
@+,

Cincap

@ Gilbert Geyer,

En fait, si tu laisse la procédure "AddToolTip" de base avec Text en Pchar, cela fonctionne pour le multilignes et aussi pour un TMemo.

Code:

1
2
3
 
procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;
  Title, Text: PChar);   //Text : Pchar ou Text : String pour un TMemo

Utilisation :

Code:

1
2
3
4
5
6
7
8
9
 
 
//Avec TMemo
CreateToolTips(Memo1.Handle);
  AddToolTip(Memo1.Handle, @ti, 1, '1= Mon TMemo', pchar(Memo1.text));
 
//Multilignes
CreateToolTips(Form1.Handle);
  AddToolTip(Form1.Handle, @ti, 2, '2= Multilignes', 'Ligne1'+#13#10+'Ligne2'+#13#10+'etc');

@+,

Cincap

06/12/2011, 15h19
Gilbert Geyer
Re-Bonjour,

A Cincap :

Citation:

En fait, si tu laisse la procédure "AddToolTip" de base avec Text en Pchar, cela fonctionne pour le multilignes et aussi pour un TMemo.

Effectivement cela fonctionne mieux avec :
Code:

1 2 procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer; Title,Text : PChar);
... donc on obtient bien le multi-lignes ... "sous D6 et Seven 64 Bits" ET sous D5 : merci pour ton recadrage.

A+.:D

Voir 40 message(s) de cette discussion en une page