CustomEdit: TextHint immer sichtbar machen?

[Strict]

Es gibt keinen Fehler, der angezeigt wird.

Ich habe hier was gefunden https://stackoverflow.com/questions/...t-control-text und es ein wenig angepasst. Schön ist anders aber ers funktioniert.

Delphi-Quellcode:

unit dEdit;

interface

uses
 Winapi.Windows, Winapi.Messages, System.UITypes, System.SysUtils, System.Classes, Vcl.StdCtrls, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Menus;

type
 TdEdit = class(TEdit)
 private
  FTextHintAlwaysVisible: Boolean;
  FCanvas: TCanvas;
  procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
 public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
 protected
  procedure WndProc(var Message: TMessage); override;
  procedure Paint; virtual;
  procedure PaintWindow(DC: HDC); override;
  property Canvas: TCanvas read FCanvas;
 published
  property TextHintAlwaysVisible: Boolean read FTextHintAlwaysVisible write FTextHintAlwaysVisible default False;
 end;

procedure register;

implementation

constructor TdEdit.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);

 FCanvas := TControlCanvas.Create;
 TControlCanvas(FCanvas).Control := Self;
end;

destructor TdEdit.Destroy;
begin
 FCanvas.Free;
 inherited Destroy;
end;

procedure TdEdit.Paint;
var
 R: TRect;
 I: Integer;

 NewColor: TColor;
 // NewBackColor: TColor;

 procedure DrawEx(S: String);
 begin
  if ((I - 1) >= SelStart) and ((I - 1) <= (SelStart + (SelLength - 1))) and (SelLength > 0) and (Focused) then
   begin
    Canvas.Font.Color := clWhite;
    Canvas.Brush.Color := NewColor;
   end
  else
   begin
    Canvas.Font.Color := NewColor;
    Canvas.Brush.Color := clWhite;
   end;
  Canvas.Brush.Style := bsSolid;
  DrawText(Canvas.Handle, PChar(S), -1, R, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
 end;

begin
 if Focused then
  begin
   Canvas.Brush.Color := clWhite;
   Canvas.Brush.Style := bsSolid;
   Canvas.FillRect(ClientRect);
  end;

 if FTextHintAlwaysVisible then
  begin
   R := ClientRect;
   Inc(R.Left, 1);
   if Text = '' then
    Inc(R.Left, 1);
   Inc(R.Top, 1);
   Canvas.Brush.Assign(Brush);
   Canvas.Font.Assign(Font);

   for I := 1 to Length(TextHint) do
    begin
     if I = Length(Text) then
      Inc(R.Left, 1)
     else if I > Length(Text) then
      begin
       NewColor := clGray;
       DrawEx(TextHint[I]);
      end;

     Inc(R.Left, Canvas.TextWidth(TextHint[I]));
    end;
  end;

 R := ClientRect;
 Inc(R.Left, 1);
 Inc(R.Top, 1);
 Canvas.Brush.Assign(Brush);
 Canvas.Font.Assign(Font);

 for I := 1 to Length(Text) do
  begin
   if PasswordChar = #0 then
    begin
     NewColor := clWindowText;
     DrawEx(Text[I]);
     Inc(R.Left, Canvas.TextWidth(Text[I]));
    end
   else
    begin
     NewColor := clWindowText;
     DrawEx(PasswordChar);
     Inc(R.Left, Canvas.TextWidth(PasswordChar));
    end;
  end;
end;

procedure TdEdit.PaintWindow(DC: HDC);
begin
 FCanvas.Lock;
 try
  FCanvas.Handle := DC;
  try
   TControlCanvas(FCanvas).UpdateTextFlags;
   Paint;
  finally
   FCanvas.Handle := 0;
  end;
 finally
  FCanvas.Unlock;
 end;
end;

procedure TdEdit.WMPaint(var Message: TWMPaint);
begin
 ControlState := ControlState + [csCustomPaint];
 inherited;
 ControlState := ControlState - [csCustomPaint];
end;

procedure TdEdit.WndProc(var Message: TMessage);
begin
 inherited WndProc(Message);
 with Message do
  case Msg of
   CM_MOUSEENTER, CM_MOUSELEAVE, WM_LBUTTONUP, WM_LBUTTONDOWN, WM_KEYDOWN, WM_KEYUP, WM_SETFOCUS, WM_KILLFOCUS, CM_FONTCHANGED, CM_TEXTCHANGED:
    begin
     Invalidate;
    end;
  end;
end;

procedure register;
begin
 RegisterComponents('dEdit', [TdEdit]);
end;

end.