[Solved] How to get TControl.Hint to respect Parent.BiDiMode?

[Avishai]

I have tried many things to get TControl.Hint to show RightToLeft but nothing seems to work.  If anyone has some ideas I would like to try them.

Testing is easy.  On any TControl with BiDiMode:= bdRightToLeft, just set the Hint text to 'Hint!'.  If the '!' shows on the Left of the text ('!Hint) then it is RightToLeft.

[ChrisF]

Here you go: a very basic sample.

[Avishai]

Thanks ChrisF, but this doesn't solve my problem.  It makes all hint R2L and I need to control the direction on a control by control basis.  To make it global, all I have to do is 'Application.BiDiMode:= bdRightToLeft;'.  Then ALL hints are R2L.  I tried changing the Applitaion.BiDiMode in the OnMouseEnter of each control, but for some reason it *seems* like it must check it only at startup because it doesn't change after that.

[engkin]

...but for some reason it *seems* like it must check it only at startup because it doesn't change after that.

If I recall correctly, normally there is only one HintWindowClass per application. It gets created once and reused afterwards. That's why it doesn't respond to your changes later. TApplication is responsible of handling hints through a few procedures like:

procedure TApplication.OnHintTimer
procedure TApplication.ShowHintWindow
procedure TApplication.StartHintTimer

You may want to pay some attention to another function called GetHintInfoAt. Use it or its approach to reach to the underlying control and to get its BidiMode.

You can destroy the hint window by

Code: [Select]

Application.ShowHint := False;
Application.ShowHint := True;

Anyway, here is one solution

Code: [Select]

type
  { TBidiHintWindow }

  TBidiHintWindow = class (THintWindow)
    function GetDrawTextFlags: Cardinal;
    procedure Paint; override;
  end;

implementation
uses
    Themes;

function GetHintControl(Control: TControl): TControl;
begin
  Result := Control;
  while (Result <> nil) and (not Result.ShowHint) do
    Result := Result.Parent;
  if (Result <> nil)and
     ([csDesigning, csDestroying, csLoading] * Result.ComponentState <> []) then
    Result := nil;
end;

function GetHintInfoAt(CursorPos: TPoint): THintInfoAtMouse;
begin
  Result.MousePos := CursorPos;
  Result.Control := GetHintControl(FindControlAtPosition(Result.MousePos, True));
  Result.ControlHasHint := Assigned(Result.Control) and Assigned(Application) and
    Application.ShowHint and (GetCapture = 0) and
   ((GetKeyState(VK_LBUTTON) and $80) = 0) and
   ((GetKeyState(VK_MBUTTON) and $80) = 0) and
   ((GetKeyState(VK_RBUTTON) and $80) = 0);
  if Result.ControlHasHint then
  begin
    // if there is a modal form, then don't show hints for other forms
    if Assigned(Screen.FocusedForm) and
       (fsModal in Screen.FocusedForm.FormState) and
       (GetParentForm(Result.Control) <> Screen.FocusedForm) then
      Result.ControlHasHint := False;
  end;
end;

{ TBidiHintWindow }

function TBidiHintWindow.GetDrawTextFlags: Cardinal;
var
  EffectiveAlignment: TAlignment;
begin
  Result := DT_NOPREFIX or DT_VCENTER or DT_WORDBREAK;
  EffectiveAlignment := Alignment;
  if BiDiMode <> bdLeftToRight then
  begin
    Result := Result or DT_RTLREADING;
    //change alignment if is RTL
    if BiDiMode = bdRightToLeft then
    begin
      case Alignment of
        taLeftJustify: EffectiveAlignment := taRightJustify;
        taRightJustify: EffectiveAlignment := taLeftJustify;
      end;
    end;
  end;
  case EffectiveAlignment of
    taLeftJustify: Result := Result or DT_LEFT;
    taCenter: Result := Result or DT_CENTER;
    taRightJustify: Result := Result or DT_RIGHT;
  end;
end;

procedure TBidiHintWindow.Paint;
var
  ARect: TRect;
  Details: TThemedElementDetails;
  TextFlags: Cardinal;

  Info: THintInfoAtMouse;
  CursorPos: TPoint;
const
  HintBorderWidth = 2;

begin
  TextFlags := GetDrawTextFlags;
  if GetCursorPos(CursorPos) then
  begin
    Info := GetHintInfoAt(CursorPos);
    if Info.Control.BiDiMode = bdRightToLeft then
       TextFlags := TextFlags or DT_RTLREADING;
  end;
  ARect := ClientRect;
  if (Color = clInfoBk) or (Color = clDefault) then
  begin
    // draw using themes
    Details := ThemeServices.GetElementDetails(tttStandardNormal);
    ThemeServices.DrawElement(Canvas.Handle, Details, ARect);
//    ARect := ThemeServices.ContentRect(Canvas.Handle, Details, ARect);
    InflateRect(ARect, -2 * HintBorderWidth, -2 * HintBorderWidth);
    ThemeServices.DrawText(Canvas, Details, Caption, ARect, TextFlags, 0);
  end
  else
  begin
    Canvas.Brush.Color := Color;
    Canvas.Pen.Width := 1;
    Canvas.FillRect(ARect);
    DrawEdge(Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT);
    InflateRect(ARect, -2 * HintBorderWidth, -2 * HintBorderWidth);
    DrawText(Canvas.GetUpdatedHandle([csFontValid]), PChar(Caption),
      Length(Caption), ARect, TextFlags);
  end;
end;


[Avishai]

Thanks engkin.

I tried your code but I get the following Errors when trying to compile:

Code: [Select]

Compiling C:\Users\Avishai\AppData\Local\Temp\project1.lpr
Compiling unit1.pas
unit1.pas(53,42) Error: Identifier not found "GetCapture"
unit1.pas(54,17) Error: Identifier not found "GetKeyState"
unit1.pas(55,17) Error: Identifier not found "GetKeyState"
unit1.pas(56,17) Error: Identifier not found "GetKeyState"
unit1.pas(107,18) Error: Identifier not found "GetCursorPos"
unit1.pas(109,36) Warning: Local variable "CursorPos" does not seem to be initialized
unit1.pas(120,16) Error: Identifier not found "InflateRect"
unit1.pas(128,13) Error: Identifier not found "DrawEdge"
unit1.pas(129,16) Error: Identifier not found "InflateRect"
unit1.pas(130,13) Error: Identifier not found "DrawText"
unit1.pas(136) Fatal: There were 9 errors compiling module, stopping

I'm too tired right now to try to sort it out so I'm going to bed

[Avishai]

After a little rest, I've decided that it just isn't worth it to try to fix this.  I can manually adjust the final punctuation to achieve my goal.

[howardpc]

I tried your code but I get the following Errors when trying to compile:

Add windows to your uses clause.

[engkin]

After a little rest, I've decided that it just isn't worth it to try to fix this.  I can manually adjust the final punctuation to achieve my goal.

Avishai,  check the attachment.

I should say that my contribution is very small  . Less than this part:

Code: [Select]

procedure TBidiHintWindow.Paint;
...
    if Info.Control.BiDiMode = bdRightToLeft then
       TextFlags := TextFlags or DT_RTLREADING;


[Avishai]

engkin, Thanks!   It works perfectly.

I think I need to apologize a bit to everyone that has tried to help me over the past several months.  I sometimes get really frustrated trying to write even very simple apps and find in the end that over 70% of my code is workarounds to get it to work for a RightToLeft world.  And even then I have had to leave out some things because I just couldn't find a solution.  Lazarus has improved R2L support significantly over the past 2 years.  But there's still a ways to go.

Anyway, thanks to all that have helped.

[ChrisF]

As BiDiMode seems to be re-evaluated each time, I'm not sure it's necessary to re-write fully the paint procedure.

Theoretically, changing the BiDiMode property on the fly should be enough (but I could be wrong).

Here is a simple approach for that.

There are several ways to test how BiDiMode must be set. I've included 3 possibilities (IsRTL1, IsRTL2, IsRTL3). The first 2 ones are really basic, while the third one corresponding to engkin's proposal is certainly much smarter, indeed.

[Avishai]

Thanks ChrisF,  I tried IsRTL1, IsRTL2, and IsRTL3.
IsRTL1 is the one that works.

Now I have 2 approaches that work

[Avishai]

I just had a chance to play with Delphi XE3 again and I checked to see what it did with Hints and BiDiMode.  Delphi had no problem.  The Hint BiDiMode followed the BiDiMode of the control, as it should be.  That's what I was expecting from Lazarus.

[Avishai]

I think I have solved this problem for MSWindows but it needs more testing.  This allows BiDiMode to control the Hint.

In the file ..\Lcl\Include\HintWindow.inc

Code: [Select]

constructor THintWindow.Create(AOwner: TComponent);
begin
  // THintWindow has no resource => must be constructed using CreateNew
  inherited CreateNew(AOwner, 1);
  fCompStyle := csHintWindow;
  Parent := nil;
  Color := clInfoBk;
  Canvas.Font := Screen.HintFont;
  Canvas.Brush.Style := bsClear;
  FAlignment := taLeftJustify;
  BorderStyle := bsNone;
  Caption := 'THintWindow';
  with GetControlClassDefaultSize do
    SetInitialBounds(0, 0, CX, CY);
  FHideInterval := 3000;
  FAutoHide := False;
  FAutoHideTimer := TCustomTimer.Create(self);
  FAutoHideTimer.Interval := HideInterval;
  FAutoHideTimer.Enabled := False;
  FAutoHideTimer.OnTimer := @AutoHideHint;

  // Added by Avishai
  //WS_EX_LAYOUTRTL = $400000;
  //NoInheritLayout = $00100000;
  {$IfDef Windows}
  if BiDiMode<>bdLeftToRight then begin
    SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE)
    or $400000 or $00100000);
  end;
  {$EndIf}
end;


[engkin]

Avishai:

... and $400000 and $00100000);

Maybe you meant "or"? Otherwise the previous code would produce 0

[Avishai]

Thanks engkin, you are right.  It should be 'OR'.  But something else seems to be going on.  I just commented out the code and got exactly the same result.  The problems is that I have tried so many things, I'm not sure what code I accidentally left active.