LCL: Implement TextHint for TComboBox. Issue #30682.

git-svn-id: trunk@63731 -

lcl/comboex.pas

@@ -254,6 +254,7 @@ type
     property TabOrder;
     property TabStop;
     property Text;
+    property TextHint;
     property Visible;
   end;
 
@@ -392,6 +393,7 @@ type
     property TabOrder;
     property TabStop;
     property Text;
+    property TextHint;
     property Visible;
   end;
 

lcl/filectrl.pp

@@ -193,6 +193,7 @@ Type
     property ShowHint;
     property TabOrder;
     property TabStop;
+    property TextHint;
     property Visible;
     { events }
     property OnChange;

lcl/include/customcombobox.inc

@@ -45,6 +45,10 @@ begin
   TWSCustomComboBoxClass(WidgetSetClass).SetReadOnly(Self, FReadOnly);
   TWSCustomComboBoxClass(WidgetSetClass).SetMaxLength(Self, FMaxLength);
   TWSCustomComboBoxClass(WidgetSetClass).SetDropDownCount(Self, FDropDownCount);
+  if WidgetSet.GetLCLCapability(lcTextHint) = LCL_CAPABILITY_YES then
+    TWSCustomComboBoxClass(WidgetSetClass).SetTextHint(Self, FTextHint)
+  else
+    ShowEmulatedTextHintIfYouCan;
 
   if FSelLength<>0 then
   begin
@@ -425,6 +429,32 @@ begin
   end;
 end;
 
+function TCustomComboBox.RealGetText: TCaption;
+begin
+  if FEmulatedTextHintShowing then
+    Result := ''
+  else
+    Result := inherited RealGetText;
+end;
+
+procedure TCustomComboBox.RealSetText(const AValue: TCaption);
+// If the text AValue occurs in the list of strings, then sets the itemindex,
+//  otherwise does the default action
+var
+  I: integer;
+begin
+  // when items have same text, FItems.IndexOf(AValue) gives wrong index. Issue #28683.
+  if AValue<>'' then
+  begin
+    I := ItemIndex;
+    if (I < 0) or (I >= FItems.Count) or (FItems[I] <> AValue) then
+      if not (csLoading in ComponentState) then
+        ItemIndex := FItems.IndexOf(AValue);
+    HideEmulatedTextHint;
+  end;
+  inherited;
+end;
+
 procedure TCustomComboBox.SetArrowKeysTraverseList(Value : Boolean);
 begin
   if Value <> FArrowKeysTraverseList then
@@ -446,6 +476,18 @@ begin
     inherited WMChar(Message);
 end;
 
+procedure TCustomComboBox.WMKillFocus(var Message: TLMKillFocus);
+begin
+  inherited WMKillFocus(Message);
+  ShowEmulatedTextHintIfYouCan;
+end;
+
+procedure TCustomComboBox.WMSetFocus(var Message: TLMSetFocus);
+begin
+  HideEmulatedTextHint;
+  inherited WMSetFocus(Message);
+end;
+
 procedure TCustomComboBox.SetCharCase(eccCharCase: TEditCharCase);
 begin
  if (FCharCase <> eccCharCase) then
@@ -468,6 +510,14 @@ begin
   RegisterPropertyToSkip(TCustomComboBox, 'ImeMode',    'VCL compatibility property', '');
 end;
 
+function TCustomComboBox.CanShowEmulatedTextHint: Boolean;
+begin
+  Result := HandleAllocated and
+            (WidgetSet.GetLCLCapability(lcTextHint)=LCL_CAPABILITY_NO) and
+            (([csDesigning,csLoading] * ComponentState) = []) and
+            (FTextHint <> '') and (Text = '') and not Focused;
+end;
+
 procedure TCustomComboBox.CreateParams(var Params: TCreateParams);
 const
   ComboBoxStyles: array[TComboBoxStyle] of dword = (
@@ -939,31 +989,6 @@ begin
   Result := FItemIndex;
 end;
 
-{------------------------------------------------------------------------------
-  Method: TCustomComboBox.RealSetText
-  Params: AValue -
-  Returns: nothing
-
-  If the text AValue occurs in the list of strings, then sets the itemindex,
-  otherwise does the default action
- ------------------------------------------------------------------------------}
-procedure TCustomComboBox.RealSetText(const AValue: TCaption);
-var
-  I: integer;
-begin
-  // when items have same text, FItems.IndexOf(AValue) gives wrong index. Issue #28683.
-  I := ItemIndex;
-  if (I < 0) or (I >= FItems.Count) or (FItems[I] <> AValue) then
-  begin
-    I := FItems.IndexOf(AValue);
-    if I >= 0 then
-      ItemIndex := I
-    else if (not (csLoading in ComponentState)) then
-      ItemIndex := -1;
-  end;
-  inherited;
-end;
-
 {------------------------------------------------------------------------------
   Method: TCustomComboBox.SetItemIndex
   Params: Val -
@@ -1091,6 +1116,49 @@ begin
   TWSCustomComboBoxClass(WidgetSetClass).SetReadOnly(Self, FReadOnly);
 end;
 
+// TextHint stuff
+
+procedure TCustomComboBox.SetTextHint(const AValue: TTranslateString);
+begin
+  if (FTextHint = AValue) then Exit;
+  FTextHint := AValue;
+  if (WidgetSet.GetLCLCapability(lcTextHint) = LCL_CAPABILITY_YES) and HandleAllocated then
+    TWSCustomComboBoxClass(WidgetSetClass).SetTextHint(Self, AValue);
+  if FTextHint = '' then
+    HideEmulatedTextHint
+  else
+    ShowEmulatedTextHintIfYouCan;
+end;
+
+procedure TCustomComboBox.ShowEmulatedTextHintIfYouCan;
+begin
+  if CanShowEmulatedTextHint then
+    ShowEmulatedTextHint;
+end;
+
+procedure TCustomComboBox.ShowEmulatedTextHint;
+var
+  HintFont: TFont;
+begin
+  HintFont := CreateEmulatedTextHintFont;
+  try
+    TWSCustomComboBoxClass(WidgetSetClass).SetFont(Self, HintFont);
+  finally
+    HintFont.Free;
+  end;
+  TWSCustomComboBoxClass(WidgetSetClass).SetText(Self, Self.TextHint);
+  FEmulatedTextHintShowing := True;
+end;
+
+procedure TCustomComboBox.HideEmulatedTextHint;
+begin
+  if not FEmulatedTextHintShowing then
+    Exit;
+  TWSCustomComboBoxClass(WidgetSetClass).SetFont(Self, Font);
+  TWSCustomComboBoxClass(WidgetSetClass).SetText(Self, '');
+  FEmulatedTextHintShowing := False;
+end;
+
 {------------------------------------------------------------------------------
   procedure TCustomComboBox.UpdateSorted;
  ------------------------------------------------------------------------------}

lcl/interfaces/qt5/qtwsstdctrls.pp

@@ -91,6 +91,7 @@ type
     class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;
     class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); override;
     class procedure SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); override;
+    class procedure SetTextHint(const ACustomComboBox: TCustomComboBox; const ATextHint: string); override;
 
     class procedure Sort(const ACustomComboBox: TCustomComboBox; AList: TStrings; IsSorted: boolean); override;
 
@@ -1601,6 +1602,17 @@ begin
     LineEdit.setReadOnly(NewReadOnly);
 end;
 
+class procedure TQtWSCustomComboBox.SetTextHint(
+  const ACustomComboBox: TCustomComboBox; const ATextHint: string);
+var
+  Widget: TQtWidget;
+  QtEdit: IQtEdit;
+begin
+  Widget := TQtWidget(ACustomComboBox.Handle);
+  if Supports(Widget, IQtEdit, QtEdit) then
+    QtEdit.setTextHint(ATextHint);
+end;
+
 {------------------------------------------------------------------------------
   Method: TQtWSCustomComboBox.GetItems
   Params:  None

lcl/stdctrls.pp

@@ -277,16 +277,18 @@ type
 
   TCustomComboBox = class(TWinControl)
   private
-    FCharCase: TEditCharCase;
+    FArrowKeysTraverseList: Boolean;
     FAutoCompleteText: TComboBoxAutoCompleteText;
     FAutoSelect: Boolean;
     FAutoSelected: Boolean;
     FAutoDropDown: Boolean;
     FCanvas: TCanvas;
+    FCharCase: TEditCharCase;
     FDropDownCount: Integer;
     FDroppedDown: boolean;
     FDroppingDown: Boolean;
     FEditingDone: Boolean;
+    FEmulatedTextHintShowing: Boolean;
     FItemHeight: integer;
     FItemIndex: integer;
     FItemWidth: integer;
@@ -300,28 +302,35 @@ type
     FOnMeasureItem: TMeasureItemEvent;
     FOnSelect: TNotifyEvent;
     FReadOnly: Boolean;
+    FReturnArrowState: Boolean; //used to return the state of arrow keys from termporary change
     FSelLength: integer;
     FSelStart: integer;
     FSorted: boolean;
     FStyle: TComboBoxStyle;
-    FArrowKeysTraverseList: Boolean;
-    FReturnArrowState: Boolean; //used to return the state of arrow keys from termporary change
+    FTextHint: TTranslateString;
     function GetAutoComplete: boolean;
     function GetDroppedDown: Boolean;
     function GetItemWidth: Integer;
     procedure SetAutoComplete(const AValue: boolean);
+    procedure SetArrowKeysTraverseList(Value: Boolean);
     procedure SetItemWidth(const AValue: Integer);
+    procedure SetCharCase(eccCharCase: TEditCharCase);
+    procedure SetReadOnly(const AValue: Boolean);
+    procedure SetTextHint(const AValue: TTranslateString);
+    procedure ShowEmulatedTextHintIfYouCan;
+    procedure ShowEmulatedTextHint;
+    procedure HideEmulatedTextHint;
+    procedure UpdateSorted;
     procedure LMDrawListItem(var TheMessage: TLMDrawListItem); message LM_DrawListItem;
     procedure LMMeasureItem(var TheMessage: TLMMeasureItem); message LM_MeasureItem;
     procedure LMSelChange(var TheMessage); message LM_SelChange;
     procedure CNCommand(var TheMessage: TLMCommand); message CN_Command;
-    procedure SetReadOnly(const AValue: Boolean);
-    procedure UpdateSorted;
-    procedure SetArrowKeysTraverseList(Value: Boolean);
     procedure WMChar(var Message: TLMChar); message LM_CHAR;
-    procedure SetCharCase(eccCharCase: TEditCharCase);
+    procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
+    procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
   protected
     class procedure WSRegisterClass; override;
+    function CanShowEmulatedTextHint: Boolean; virtual;
     procedure CreateParams(var Params: TCreateParams); override;
     procedure InitializeWnd; override;
     procedure DestroyWnd; override;
@@ -361,6 +370,7 @@ type
     procedure SetSelText(const Val: string); virtual;
     procedure SetSorted(Val: boolean); virtual;
     procedure SetStyle(Val: TComboBoxStyle); virtual;
+    function  RealGetText: TCaption; override;
     procedure RealSetText(const AValue: TCaption); override;
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
@@ -420,6 +430,7 @@ type
     property Style: TComboBoxStyle read FStyle write SetStyle default csDropDown;
     property TabStop default true;
     property Text;
+    property TextHint: TTranslateString read FTextHint write SetTextHint;
   end;
 
 
@@ -496,6 +507,7 @@ type
     property TabOrder;
     property TabStop;
     property Text;
+    property TextHint;
     property Visible;
   end;
 

lcl/widgetset/wsstdctrls.pp

@@ -87,6 +87,7 @@ type
     class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); virtual;
     class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); virtual;
     class procedure SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); virtual;
+    class procedure SetTextHint(const ACustomComboBox: TCustomComboBox; const ATextHint: string); virtual;
 
     class function  GetItems(const ACustomComboBox: TCustomComboBox): TStrings; virtual;
     class procedure FreeItems(var AItems: TStrings); virtual;
@@ -495,6 +496,11 @@ class procedure TWSCustomComboBox.SetReadOnly(const ACustomComboBox: TCustomComb
 begin
 end;
 
+class procedure TWSCustomComboBox.SetTextHint(
+  const ACustomComboBox: TCustomComboBox; const ATextHint: string);
+begin
+end;
+
 class function  TWSCustomComboBox.GetItems(const ACustomComboBox: TCustomComboBox
   ): TStrings;
 begin