Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Delphi XE7: TEdit TextHint Color

i would like to change to gray color of the Texthint of my TEdits.

I allready found this https://stackoverflow.com/a/31550017/1862576 and tried to change to color via SendMessage like this

procedure TEdit.DoSetTextHint(const Value: string);
var
  Font: TFont;
begin
  if CheckWin32Version(5, 1) and StyleServices.Enabled and HandleAllocated then
  begin
    Font := TFont.Create;
    try
      Font.Assign(self.Font);
      Font.Color := clGreen;
      Font.Size := 20;

      SendTextMessage(Handle, EM_SETCUEBANNER, WPARAM(1), Value);
      SendMessage(Handle, WM_SETFONT, Integer(Font.Handle), Integer(True));
    finally
//      Font.Free;
    end;
  end;    
end;

It changes the size of the font but not the color. Thanks for your help.

like image 754
Philipp H. Avatar asked Dec 07 '25 01:12

Philipp H.


1 Answers

Definition:

Type
    HitColor = class helper  for tEdit
      private
        procedure SetTextHintColor(const Value: TColor);
        function GetTextHintColor: TColor;
        procedure fixWndProc(var Message: TMessage);
    published
       property TextHintColor : TColor  read GetTextHintColor write SetTextHintColor;
     end;

Implementation:

procedure HitColor.fixWndProc(var Message: TMessage);
var
  dc : HDC ;
  r : TRect ;
  OldFont: HFONT;
  OldTextColor: TColorRef;
  Handled : boolean;
begin
     Handled := false;
     if   (Message.Msg = WM_PAINT)  and (Text  = '') and not Focused then
                  begin

                    self.WndProc(Message);
                    self.Perform(EM_GETRECT, 0, LPARAM(@R));
                    dc := GetDC(handle);
                   try
                      OldFont := SelectObject(dc,  Font.Handle );
                      OldTextColor := SetTextColor(DC,  ColorToRGB(GetTextHintColor));

                      FillRect(dc,r,0);
                      DrawText(DC, PChar(TextHint), Length(TextHint), R, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX);
                    finally
                       SetTextColor(DC, OldTextColor);
                       SelectObject(DC, OldFont);
                       ReleaseDC(handle,dc);
                    end;
                  Handled := true;
                end;




    if not Handled then WndProc(Message);

end;

function HitColor.GetTextHintColor: TColor;
begin
  result := tag;
end;

procedure HitColor.SetTextHintColor(const Value: TColor);
begin
  tag :=  Value;
  WindowProc := fixWndProc ;
end;

Usage:

edit1.TextHintColor := clred;
like image 77
Egor Avatar answered Dec 08 '25 16:12

Egor