Discussion :

[Gilbert Geyer]

Bonjour,

J'utilise une StatusBar en vue de pouvoir y afficher sur toute la largeur de l'écran le contenu des Hint explicatifs associés aux autres composants (StatuBar1.AutoHint:=True) mais malgré les instructions suivantes placées dans le FormCreate :

Code :

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

1
2
WindowState:=wsMaximized;
StatusBar1.Panels[0].Width:=Width; 

le texte n'apparaît que sur environ un tiers de la largeur de l'écran et les reste du texte est tronqué.
Et c'est le même problème lorsque je remplace l'utilisation de StatusBar1.Panels[0].Text := ... par StatusBar1.SimpleText := ...

Existe-t-il un remède à ce problème ? S.V.P ?

A+.

[ShaiLeTroll]

Ta StatusBar est bien en Align alBottom
Lors OnResize, force un petit Refresh

J'ai eu un bug étrange, sur un TStatusBar, il me dessinait le contenu des 2 premiers MenuItem du TMainMenu surement lié au DrawPanel qui a été fait à l'arrache par mon prédecesseur !
Un petit Resize et le défaut graphique disparait !
Je ne me suis pas encore attardé sur ce problème mineur !

n'oublie pas que SimpleText ne fonctionne qui si SimplePanel est à true

Count de Panels est bien à 1 ?

J'ai toujours trouvé dommage que AutoHint s'affiche forcément dans le Premier Panel

[Gilbert Geyer]

Re-bonjour,

Merci ShaiLeTroll

Ta StatusBar est bien en Align alBottom :

OUI.

Lors OnResize, force un petit Refresh

J'ai ajouté le FormResize suivant :

Code :

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

1
2
3
4
5
procedure TfrmSudo.FormResize(Sender: TObject);
begin
  WindowState:=wsMaximized;
  StatusBar1.Panels[0].Width:=Width;
end;

mais ça n'y change rien.

n'oublie pas que SimpleText ne fonctionne qui si SimplePanel est à true

SimplePanel était bien à true lors de l'essai avec SimpleText.

Count de Panels est bien à 1 ? :

OUI.

J'ai toujours trouvé dommage que AutoHint s'affiche forcément dans le Premier Panel

Cela forme une limitation de plus qui s'ajoute à celle du texte tronqué.

A+.

EDIT : Vérification faite, le texte le plus long compte 129 caractères et un ShowMessage sur IntToStr(length(statusbar1.Panels[0].text)) placé dans la procédure ...BoutonKMouseMove du bouton dont le hint inclut les 129 caractères me dit qu'il n'y en a que 50 !!!
Donc ça tronque même une ShortString !!!

[tourlourou]

Bonjour Gilbert,

Tu as peut-être des éléments ici : http://www.developpez.net/forums/d12...e/#post6889464.

Bon code !

[Gilbert Geyer]

Bonjour Tourlourou,

Tu as peut-être des éléments ici : http://www.developpez.net/forums/d12...e/#post6889464.

Merci, j'ai essayé de m'en inspirer en faisant ceci :

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
procedure TFormMain.StatusBar1Hint(Sender: TObject) :
var zone_client: tRect;  txt : string;
begin
   txt:= StatusBar1.Panels[0].text; //<- Ceci ne récupère pas le texte des Hint malgré le fait que StatusBar1.AutoHint = TRUE
  with StatusBar1.Canvas do
  begin
    StatusBar1.Canvas.Brush.Color := StatusBar1.Color;
    StatusBar1.Canvas.Font := StatusBar1.Font;
    zone_client := StatusBar1.ClientRect;
    zone_client.Top := StatusBar1.ClientRect.Top + 3; //
    zone_client.Bottom := StatusBar1.ClientRect.Bottom - 1;
    zone_client.Left := StatusBar1.ClientRect.Left + 1;
    zone_client.Right := StatusBar1.ClientRect.Right - 1;

    FillRect(zone_client); // Peindre le canvas.
    TextRect(zone_client, 2, 2, stringOfChar('A', 1000)); // <- Affiche bien sur toute la largeur de l'écran
    TextRect(zone_client, 2, 2, txt); // <-- mais ceci n'affiche rien du tout
  end;
end;

... le stringOfChar('A', 1000) s'affiche bien correctement sur toute la largeur,
... mais comment récupérer dans la variable txt le texte des Hint des Menus, Boutons, et TMemos ???

A+.

EDIT : Et avec txt:= StatusBar1.SimpleText; Ceci ne récupère pas non plus le texte des Hint malgré le fait que StatusBar1.AutoHint et StatusBar1.SimplePanel sont à TRUE après suppression du StatusBar1.Panels[0].

[ShaiLeTroll]

... mais comment récupérer dans la variable txt le texte des Hint des Menus, Boutons, et TMemos

On avait discuté de cela Problème avec TMenuItem.Hint

Si TStatusBar.OnHint est défini, cela inhibe le traitement de ActionExecute sur les THintAction - Voir ComCtrls.pas L7433
Si TApplication.OnHint est défini, cela ne provoque même plus l'appel des THintAction.Execute donc pas d'ActionExecute non plus - Voir forms.pas L10857

TApplicationEvents.OnHint

Code c++ :

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
//---------------------------------------------------------------------------
void __fastcall TVCLManipForm::ApplicationEventsHint(TObject *Sender)
{
  StatusBarVCLManip->Panels->Items[1]->Text = Application->Hint; // ApplicationEvents OnHint annule le comportement par défaut du AutoHint même si true !!!
}
 
//---------------------------------------------------------------------------
void __fastcall TVCLManipForm::FormResize(TObject *Sender)
{
  StatusBarVCLManip->Panels->Items[1]->Width = StatusBarVCLManip->Width -
  StatusBarVCLManip->Panels->Items[0]->Width -
  StatusBarVCLManip->Panels->Items[2]->Width -
  StatusBarVCLManip->Panels->Items[3]->Width -
  StatusBarVCLManip->Panels->Items[4]->Width;
}
 
/* Cela affiche le Hint d'un TMemo : "Voici une très très longue chaine de conseil sur un contrôle que l'on doit afficher dans la Barre de Status d'une longeur de 130 caractères minimum, j'espère que cela atteins même ici les 190 caractères formant un total de 239 caractères !"*/

Si tu ne veux pas faire de OnHint, ajoute un TApplicationEvents.OnActionExecute
prend que les Actions de la classe THintAction
puis chope THintAction(Action).Hint;

C'est ni plus ni plus ce que fait le code gérant le AutoHint du TStatusBar

Par contre OnHint et OnActionExecute recevant des THintAction ne peuvent pas cohabiter, OnHint est prioritaire et inhibe les THintAction

[Gilbert Geyer]

Re-bonjour,

Merci ShaiLeTroll.

Pour commencer j'ai essayé avec l'exemple de code donné par Embarcadero en suivant ton lien : TApplicationEvents.OnHint et à cet effet j'ai ajouté une ListBox comme l'indique l'introduction à l'exemple :

Code :

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

1
2
3
4
5
6
7
8
9
procedure TFormMain.ApplicationEventsHint(Sender: TObject);
begin
  lbOther.Items.Add('Event OnHint');
end;
 
procedure TFormMain.ApplicationEventsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo);
begin
  lbOther.Items.Add('Event OnShowHint');
end;

mais les 'Event OnShowHint' et 'Event OnHint' n'apparaissent même pas dans cette ListBox. !!!???
J'ai bien placé Application.ShowHint := True; dans FormCreate.

Bon, je vais essayer avec un TApplicationEvents.OnActionExecute pour voir.

Et si rien ne marche je vais réduire la taille de la Fonte du Statusbar et réduire la longueur des textes des Hint.

A+.

[Gilbert Geyer]

Re-bonjour,

Bin en final comme je n'ai jamais utilisé les Actions je vais laisser tomber et
me contenter de modifier la taille de la Fonte et la longueur des textes de Hint.

A+.

[ShaiLeTroll]

mais les 'Event OnShowHint' et 'Event OnHint' n'apparaissent même pas dans cette ListBox. !!!???
J'ai bien placé Application.ShowHint := True; dans FormCreate.

Tu utilises encore un vieux vieux Delphi ?
Sous C++Buider XE3, le ApplicationEventsHint affiche Hint de Menu et du TMemo

Je n'ai pas changé ShowHint du TApplication dans mon projet
Il est par défaut à true selon l'aide

Ce qui est important c'est le Hint\ShowHint des TMemo et TMenuItem
C'est lors de leur survol que tu as l'Event OnHint ou OnActionExecute

Bin en final comme je n'ai jamais utilisé les Actions je vais laisser tomber et

Pondu directement sur le forum, je te laisse essayer quand même
n'oublie pas de retirer les OnHint !!!

Code :

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

1
2
3
4
5
procedure TForm1.ApplicationEvents1ActionExecute(Action: TBasicAction; var Handled: Boolean);
begin
  if Action is THintAction then
     lbOther.Items.Add(THintAction(Action).Hint);
end;

le code original fonctionnel sous C++XE3

Code c++ :

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
void __fastcall TVCLManipForm::ApplicationEventsActionExecute(TBasicAction *Action,
          bool &Handled)
{
  // le AutoHint fonctionne en parallèle !
  THintAction* ha = dynamic_cast<THintAction*>(Action);
  if (ha)
     MemoCannotHaveObjects->Lines->Add(ha->Hint);
}
 
//---------------------------------------------------------------------------
void __fastcall TVCLManipForm::RadioGroupHintCaptureClick(TObject *Sender)
{
  if (RadioGroupHintCapture->ItemIndex == 0)
    ApplicationEvents->OnHint = ApplicationEventsHint;
  else
    ApplicationEvents->OnHint = NULL;
}
 
//---------------------------------------------------------------------------
void __fastcall TVCLManipForm::ApplicationEventsHint(TObject *Sender)
{
  StatusBarVCLManip->Panels->Items[1]->Text = Application->Hint; // ApplicationEvents OnHint annule le comportement par défaut du AutoHint même si true !!!

Code dfm :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
object RadioGroupHintCapture: TRadioGroup
  Left = 447
  Top = 55
  Width = 185
  Height = 67
  Caption = 'Hint Capture'
  ItemIndex = 0
  Items.Strings = (
    'OnHint'
    'OnActionExecute')
  TabOrder = 6
  OnClick = RadioGroupHintCaptureClick
end

[Gilbert Geyer]

Re-bonjour,

Merci ShaiLeTroll

Tu utilises encore un vieux vieux Delphi ?

J'ai remplacé il y a peu de temps D5 par D6 dont je pense n'utiliser que 10% des possibilités!.

Pondu directement sur le forum, je te laisse essayer quand même
n'oublie pas de retirer les OnHint !!!

Ok, merci, j'essayerai cette solution demain matin car comme je suis scotché à ma bécane depuis ce matin faut que je rattrape mon repas de midi.

A+.

[Gilbert Geyer]

Bonjour,

1) Bon, j'ai essayé ceci après avoir retiré le OnHint :

procedure TFomrMain.ApplicationEvents1ActionExecute(Action: TBasicAction; var Handled: Boolean);
begin
ShowMessage('Interception');
if Action is THintAction then
lbOther.Items.Add(THintAction(Action).Hint);
end;

... mais l'évènement n'est pas détecté et rien ne déclenche ni le ShowMessage ni l'affichage des Hint dans la ListBox 'lbOther'.

2) Concernant le Code dfm de l'object RadioGroupHintCapture: TRadioGroup :
Je n'ai pas bien compris le sens de cet exemple car j'y vois OnClick = RadioGroupHintCaptureClick mais pas le contenu de la procédure RadioGroupHintCaptureClick()

3) Conclusion : Comme je n'arrive pas à récupérer ni l'évènement ni les HintStrings je laisse tomber. Dommage car cela aurait permis de tracer les textes avec un simple TextOut() sur le StatusBar1.Canvas.

A+.

[Gilbert Geyer]

Bonjour,

A force de galérer j'ai enfin trouvé la solution.

Et voici la solution qui fonctionne (Delphi 6 sous Windows 7) :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 // Dans l''interface :

// Ajouter ComCtrls, StdActns, dans le uses

type // Statusbar pour texte non tronqué :
  TStatusBar = class(ComCtrls.TStatusBar)
  private
  public
    function ExecuteAction(Action: TBasicAction): Boolean; override;
  end;

var SB: TStatusBar;

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
// Dans implementation :

{$R *.DFM}

function TStatusBar.ExecuteAction(Action: TBasicAction): Boolean;
// StatusBar sans troncature du Hint-texte 
var HintText: string;   ZC: tRect;
begin
  if AutoHint and not (csDesigning in ComponentState) and
    (Action is THintAction) and not DoHint then begin
    HintText := THintAction(Action).Hint;
    ZC := SB.ClientRect;
    with Canvas do begin
      Brush.Style := bsSolid;
      Brush.Color := color;
      InflateRect(ZC, -3, -3);
      FillRect(ZC);
      Font.Style := SB.Font.Style;
      Brush.Style := bsClear;
      Canvas.TextOut(ZC.Left + 2, ZC.Top + 2, HintText);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SB := TStatusBar.Create(Form1);
  with SB do begin
    Parent := Form1;
    Visible := true;
    AutoHint := true;
    Color := clSilver;
    Height := 24; BorderWidth:=1;
    UseSystemFont := False;
    Font.Name := 'Arial';
    Font.Color := clBlack;
    Font.Style := [fsBold];
  end;
  Application.HintHidePause := 15000;
end;

Ouf, après 2 ans de

A+.