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.