我想需要一些字段。而当他们不会被填写时,他们将是红色的,需要填写。在帖子可以完成之前
这是我想要实现的屏幕截图:
我会添加一个TShape
,它可以在您的编辑框周围画一条红线。如果您希望红色边框替换正常的 TEdit 边框,您可以修改 Edit 控件的属性,使其没有边框。
如果您希望形状未填充,请将画笔样式更改为bsClear
如果需要,您可以挂钩 WM_Paint 消息并在 ControlCanvas 上绘制一个矩形。一种方法可能如下所示:
unit Edit_WithFrame_If_Needed_But_Empty;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TEdit = Class(StdCtrls.TEdit)
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure WMKEYUP(var Message: TWMPaint); message WM_KEYUP;
private
FPaintedRed: Boolean;
FRequired: Boolean;
procedure CheckForInvalidate;
published
public
Property Required: Boolean read FRequired Write FRequired;
End;
TForm2 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
{ TEdit }
procedure TEdit.CheckForInvalidate;
begin
if Required and (Length(Trim(Text)) = 0) then
begin
if not FPaintedRed then
Invalidate;
end
else if FPaintedRed then
Invalidate;
end;
procedure TEdit.CMTextChanged(var Message: TMessage);
begin
inherited;
CheckForInvalidate;
end;
procedure TEdit.WMKEYUP(var Message: TWMPaint);
begin
CheckForInvalidate;
end;
procedure TEdit.WMPaint(var Message: TWMPaint);
var
CC: TControlCanvas;
begin
inherited;
if Required and (Length(Trim(Text)) = 0) then
begin
FPaintedRed := true;
CC := TControlCanvas.Create;
try
CC.Control := Self;
CC.Pen.Color := clRed;
CC.Pen.Width := 3;
CC.Rectangle(ClientRect);
finally
CC.Free;
end;
end
else
FPaintedRed := false;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
Edit1.Required := true;
Edit3.Required := true;
end;
end.