1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
| unit lzEdit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources,
StdCtrls, {Tedit}
Graphics, {TColor}
LCLIntf,
LCLType {TPaintStruct},
LMessages,
Dialogs;
type
TlzEdit = class(TEdit)
private
{ Private declarations }
FDisabledColor: TColor;
FDisabledTextColor: TColor;
procedure WMPaint(var msg: TLMPaint); message LM_PAINT;
procedure WMEraseBkGnd(var msg: TLMEraseBkGnd); message LM_ERASEBKGND;
procedure SetDisabledColor(const Value: TColor); virtual;
procedure SetDisabledTextColor(const Value: TColor); virtual;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property DisabledTextColor: TColor
read FDisabledTextColor
write SetDisabledTextColor default clGrayText;
property DisabledColor: TColor
read FDisabledColor
write SetDisabledColor default clWindow;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Additionlz',[TlzEdit]);
end;
constructor TlzEdit.Create(aOwner: TComponent);
begin
inherited;
FDisabledColor := clWindow;
FDisabledTextColor := clGrayText;
end;
destructor TlzEdit.Destroy;
begin
inherited Destroy;
end;
procedure TlzEdit.SetDisabledColor(const Value: TColor);
begin
if FDisabledColor <> Value then begin
FDisabledColor := Value;
if not Enabled then Invalidate;
end;
end;
procedure TlzEdit.SetDisabledTextColor(const Value: TColor);
begin
if FDisabledTextColor <> Value then begin
FDisabledTextColor := Value;
if not Enabled then Invalidate;
end;
end;
procedure TlzEdit.WMEraseBkGnd(var msg: TLMEraseBkGnd);
var
Canvas: TCanvas;
begin
if Enabled then
inherited
else begin
Canvas := TCanvas.Create;
try
Canvas.Handle := msg.DC;
SaveDC(msg.DC);
try
Canvas.Brush.Color := FDisabledColor;
Canvas.Brush.Style := bsSolid;
Canvas.Fillrect(ClientRect);
msg.Result := 1;
finally
RestoreDC(msg.DC, - 1);
end;
finally
Canvas.free
end;
end;
end;
procedure TlzEdit.WMPaint(var msg: TLMPaint);
var
Canvas : TCanvas;
PS : TPaintStruct;
CallEndPaint: Boolean;
R : TRect;
begin
if Enabled then
inherited
else begin
CallEndPaint := False;
Canvas := TCanvas.Create;
try
if msg.DC <> 0 then begin
Canvas.Handle := msg.DC;
PS.fErase := True;
end else begin
BeginPaint(Handle, PS);
CallEndPaint:= True;
Canvas.Handle := PS.hdc;
end;
if PS.fErase then Perform(LM_ERASEBKGND, Canvas.Handle, 0);
SaveDC(Canvas.Handle);
try
Canvas.Brush.Style := bsClear;
Canvas.Font := Font;
Canvas.Font.Color := FDisabledTextColor;
R := ClientRect;
R.Top := ClientRect.Top +1; { BorderStyle <-> bsSingle Bug ?}
R.Left := ClientRect.Left +1;
if Alignment = taLeftJustify then begin
DrawText(Canvas.Handle, PChar(Text), Length(Text), R,
DT_VCENTER or DT_LEFT);
// DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS);
end else if Self.Alignment = taRightJustify then begin
DrawText(Canvas.Handle, PChar(Text), Length(Text), R,
DT_SINGLELINE or DT_RIGHT)
end
else if Alignment = taCenter then begin
DrawText(Canvas.Handle, PChar(Text), Length(text), R,
DT_SINGLELINE or DT_CENTER)
end
else begin{cas normalement impossible}
DrawText(Canvas.Handle, PChar(Text), Length(Text), R,
DT_SINGLELINE or DT_LEFT);
end;
// Canvas.TextOut(1, 1, Text);
finally
RestoreDC(Canvas.Handle, - 1);
end;
finally
if CallEndPaint then EndPaint(Handle, PS);
Canvas.Free
end;
end;
end;
end. |
Partager