FshEditInteger
FshEditFloat
FshEditCurrency
lazarus / windows için
herhangi bir sorunla karşılaşan bildirsin lütfen..
Kod: Tümünü seç
unit FshEdit;
{$mode objfpc}{$H+}
interface
uses
Classes, LResources, Controls, Graphics, StdCtrls, LMessages, LCLType,
LclIntf, SysUtils, Forms, Dialogs, Clipbrd;
{==============================================================================}
type
{ TFshEditCustom }
TFshEditCustom = class(TCustomEdit)
private
FActColor : TColor;
FActColorText : TColor;
FAlignment : TAlignment;
FCanvas : TControlCanvas;
FCanvass : TCanvas;
TActColor : TColor;
TActColorText : TColor;
FEnterTab : Boolean;
ffocused : Boolean;
procedure SetActColors (const AValue: TColor);
procedure SetActTextColors(const AValue: TColor);
procedure SetAlignment(const AValue: TAlignment);
protected
procedure DoEnter; Override;
procedure DoExit ; Override;
procedure KeyPress (var Key: Char); Override;
procedure WMPaint (var Message: TLMPaint); message LM_PAINT;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
Property Action;
Property Align;
Property Anchors;
Property AutoSize;
Property BorderSpacing;
Property Charcase;
Property Color;
Property Constraints;
Property Cursor;
Property EchoMode;
Property Enabled;
Property Font;
Property Height;
Property HelpconText;
Property HelpKeyWord;
Property HelpType;
Property Hint;
Property Left;
Property MaxLength;
Property Name;
Property PasswordChar;
Property PopupMenu;
Property ReadOnly;
Property ShowHint;
Property TabOrder;
Property TabStop;
Property Tag;
Property Top;
Property Visible;
Property Width;
Property OnChange;
Property OnChangeBounds;
Property OnClick;
Property OnEditingDone;
Property OnEnter;
Property OnExit;
Property OnKeyDown;
Property OnKeyPress;
Property OnKeyUp;
Property OnMouseDown;
Property OnMouseMove;
Property OnMouseUp;
Property OnResize;
property ActColor : TColor read FActColor write SetActColors;
property ActColorText : TColor read FActColorText write SetActTextColors;
property Alignment : TAlignment read FAlignment write SetAlignment;
property EnterTab : Boolean read FEnterTab write FEnterTab default true;
end;
{==============================================================================}
type
{ TFshEditString }
TFshEditString = class(TFshEditCustom)
public
constructor Create (AOwner : TComponent); Override;
destructor Destroy; override;
published
Property Text;
property Alignment default taLeftJustify;
end;
{==============================================================================}
{ TFshEditInteger }
TFshEditInteger = class(TFshEditCustom)
private
Fvalue : integer;
Tsp : string;
procedure SetValue (const AValue: integer);
protected
procedure KeyPress (var Key: Char); Override;
procedure KeyDown (var Key: Word; Shift: TShiftState); override;
procedure DoExit ; Override;
public
Constructor Create (AOwner : TComponent); Override;
procedure Change; override;
published
property Alignment default taRightJustify;
property Value : integer read Fvalue write SetValue default 0;
end;
{==============================================================================}
{ TFshEditFloat }
TFshEditFloat = class(TFshEditCustom)
private
Fdecimal : Integer;
Fvalue : Real;
Tsp : string;
Dsp : string;
Msk : string;
procedure SetDecimal (const AValue: Integer);
procedure SetValue (const AValue: Real);
protected
procedure KeyPress (var Key: Char); Override;
procedure KeyDown (var Key: Word; Shift: TShiftState); override;
procedure DoExit ; Override;
public
Constructor Create (AOwner : TComponent); Override;
procedure Change ; override;
published
property Alignment default taRightJustify;
property Value : Real read Fvalue write SetValue;
property Decimal : Integer read Fdecimal write SetDecimal;
end;
{==============================================================================}
{ TFshEditCurrency }
TFshEditCurrency = class(TFshEditCustom)
private
Fdecimal : Integer;
Fvalue : Currency;
FMoney : string;
Tsp : string;
Dsp : string;
Msk : string;
procedure SetDecimal (const AValue: Integer);
procedure SetMoney (const AValue: string);
procedure SetValue (const AValue: Currency);
protected
procedure KeyPress (var Key: Char); Override;
procedure KeyDown (var Key: Word; Shift: TShiftState); override;
procedure DoExit ; Override;
public
Constructor Create (AOwner : TComponent); Override;
procedure Change ; override;
published
property Alignment default taRightJustify;
property Value : Currency read Fvalue write SetValue;
property Decimal : Integer read Fdecimal write SetDecimal;
property Money : string read FMoney write SetMoney;
end;
{==============================================================================}
procedure Register;
function TextMargins(Editor:tFshEditCustom):TPoint;
function SrPaint(Editor: tFshEditCustom; const AText: string;
AAlignment: TAlignment; StdPaint: Boolean; var ACanvas:TControlCanvas;
var Message:TLMPaint):Boolean;
implementation
procedure Register;
begin
RegisterComponents
('FSH',[TFshEditString, TFshEditInteger, TFshEditFloat, TFshEditCurrency]);
end;
{------------------------------------------------------------------------------}
{ TFshEditCustom }
{------------------------------------------------------------------------------}
constructor TFshEditCustom.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
height := 19;
width := 120;
FActColor := ClWhite;
FActColorText := ClRed;
ParentCtl3D := False;
Ctl3D := False;
Color := ClInfoBk;
Font.Color := ClNavy;
FEnterTab := true;
FFocused := false;
FAlignment := taLeftJustify;
end;
{------------------------------------------------------------------------------}
destructor TFshEditCustom.Destroy;
begin
inherited Destroy;
fcanvas.Free;
end;
{------------------------------------------------------------------------------}
procedure TFshEditCustom.DoEnter;
begin
inherited DoEnter;
TActColor := Color;
TActColorText := Font.Color;
Color := FActColor;
Font.Color := FActColorText;
FFocused := true;
end;
{------------------------------------------------------------------------------}
procedure TFshEditCustom.DoExit;
begin
inherited DoExit;
Color := TActColor;
Font.Color := TActColorText;
FFocused := false;
end;
{------------------------------------------------------------------------------}
procedure TFshEditCustom.SetActColors(const AValue: TColor);
begin
if FActColor = AValue then exit;
FActColor := AValue;
end;
{------------------------------------------------------------------------------}
procedure TFshEditCustom.SetActTextColors(const AValue: TColor);
begin
if FActColorText = AValue then exit;
FActColorText := AValue;
end;
{------------------------------------------------------------------------------}
procedure TFshEditCustom.SetAlignment(const AValue: TAlignment);
begin
if FAlignment = AValue then exit;
FAlignment := AValue;
invalidate;
end;
{------------------------------------------------------------------------------}
procedure TFshEditCustom.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if ((key=#13) and (EnterTab=true)) then
begin
key := #0;(Owner as TWinControl).SelectNext(Self, True, True);
end;
end;
{------------------------------------------------------------------------------}
procedure TFshEditCustom.WMPaint(var Message: TLMPaint);
var
S: string;
begin
if alignment<>taLeftJustify then
begin
S := Text;
if not SrPaint(Self,S,FAlignment,FFocused,FCanvas,Message) then inherited;
end
else
begin
inherited;
end;
end;
{------------------------------------------------------------------------------}
{ TFshEditString }
{------------------------------------------------------------------------------}
constructor TFshEditString.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Alignment := taLeftJustify;
end;
{------------------------------------------------------------------------------}
destructor TFshEditString.Destroy;
begin
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{ TFshEditInteger }
{------------------------------------------------------------------------------}
constructor TFshEditInteger.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Alignment := taRightJustify;
Tsp := ThousandSeparator;
Text := '0';
Value := 0;
end;
{------------------------------------------------------------------------------}
procedure TFshEditInteger.SetValue(const AValue: integer);
begin
if Fvalue = AValue then exit;
Fvalue := AValue;
Text := formatfloat(',0', value);
end;
{------------------------------------------------------------------------------}
procedure TFshEditInteger.KeyPress(var Key: Char);
var
Keys : Char;
TmpStr : String;
CurPos, Er1, Sp1, Sp2, i : Integer;
begin
inherited KeyPress(Key);
Keys := Key ; Key := #0;
if not (Keys in ['0'..'9','-', #8]) then exit;
CurPos := SelStart;
if SelLength = Length(Text) then Text:= '';
Sp1 := 0; Sp2 := 0;
if (Keys in ['0'..'9']) then
begin
for i:=1 to length(Text) do if copy(Text, i, 1) = Tsp then Sp1 := Sp1+1;
TmpStr := copy(text,1,CurPos)+Keys+copy(text,CurPos+1,length(text));
TmpStr := StringReplace(TmpStr, Tsp, '', [rfReplaceAll]);
if not (TryStrToInt(TmpStr, Er1)) then exit;
Text := copy(text,1,CurPos)+Keys+copy(text,CurPos+1,length(text));
for i:=1 to length(Text) do if copy(Text, i, 1) = Tsp then Sp2 := Sp2+1;
if Sp2> Sp1 then SelStart := CurPos + 2 else SelStart := CurPos + 1;
end;
if Keys = #8 then
begin
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp1 := Sp1 + 1;
if copy(text,CurPos,1)= Tsp then CurPos := CurPos -1;
Text := copy(text,1,CurPos-1)+copy(text,CurPos+1,length(text));
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp2 := Sp2 + 1;
if Sp2 = Sp1 then SelStart := CurPos - 1 else SelStart := CurPos - 2;
end;
if Keys = '-' then
begin
Value := -1* Value;
if Value < 0 then SelStart := CurPos + 1 else SelStart := CurPos - 1;
end;
end;
{------------------------------------------------------------------------------}
procedure TFshEditInteger.KeyDown(var Key: Word; Shift: TShiftState);
var
CurPos, Sp1, Sp2, i :integer;
begin
inherited KeyDown(Key, Shift);
if key = 46 then
begin
Key := 0;
CurPos:= SelStart+1;
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp1 := Sp1 + 1;
if copy(text,CurPos,1)= Tsp then CurPos := CurPos +1;
Text := copy(text,1,CurPos-1)+copy(text,CurPos+1,length(text));
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp2 := Sp2 + 1;
if Sp2 = Sp1 then SelStart := CurPos else SelStart := CurPos - 1;
end;
if (Key = 37) or (Key = 38) then
if copy(text,SelStart-1,1)=Tsp then SelStart := SelStart - 1;
if (Key = 39) or (Key = 40) then
if copy(text,SelStart+2,1)=Tsp then SelStart := SelStart + 1;
end;
{------------------------------------------------------------------------------}
procedure TFshEditInteger.DoExit;
begin
inherited DoExit;
text := formatfloat(',0',value);
end;
{------------------------------------------------------------------------------}
procedure TFshEditInteger.Change;
var
Er2 : integer;
begin
inherited Change;
if (text = '') or
(not(TryStrToInt(StringReplace(text, Tsp,'',[rfReplaceAll]),Er2)))then
begin
Value := 0;
Text := '';
end
else
begin
Value := strtoint(StringReplace(text, Tsp, '', [rfReplaceAll]));
end;
end;
{------------------------------------------------------------------------------}
{ TFshEditFloat }
{------------------------------------------------------------------------------}
constructor TFshEditFloat.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Alignment := taRightJustify;
Tsp := ThousandSeparator;
Dsp := DecimalSeparator;
Msk := ',0';
Decimal := 0;
Text := '0';
Value := 0;
end;
{------------------------------------------------------------------------------}
procedure TFshEditFloat.SetValue(const AValue: Real);
begin
if Fvalue = AValue then exit;
Fvalue := AValue;
Text := FormatFloat(Msk, Value);
end;
{------------------------------------------------------------------------------}
procedure TFshEditFloat.SetDecimal(const AValue: Integer);
begin
if Fdecimal = AValue then exit;
FDecimal := AValue;
if decimal = 0 then Msk:= ',0' else Msk:= ',0.'+ StringOfChar('0',Decimal);
Text := FormatFloat(Msk, Value);
end;
{------------------------------------------------------------------------------}
procedure TFshEditFloat.KeyPress(var Key: Char);
var
Keys : Char;
TmpStr : String;
Er1 : Real;
CurPos, Sp1, Sp2, i : Integer;
begin
inherited KeyPress(Key);
Keys := Key ; Key := #0;
if not (Keys in ['0'..'9','-','.',',',#8]) then exit;
CurPos := SelStart;
if SelLength = Length(Text) then Text:= '';
Sp1 := 0; Sp2 := 0;
if (Keys in ['0'..'9']) then
begin
for i:=1 to length(Text) do if copy(Text, i, 1) = Tsp then Sp1 := Sp1+1;
TmpStr := copy(text,1,CurPos)+Keys+copy(text,CurPos+1,length(text));
TmpStr := StringReplace(TmpStr, Tsp, '', [rfReplaceAll]);
if not (TryStrToFloat(TmpStr, Er1)) then exit;
Text := copy(text,1,CurPos)+Keys+copy(text,CurPos+1,length(text));
for i:=1 to length(Text) do if copy(Text, i, 1) = Tsp then Sp2 := Sp2+1;
if Sp2> Sp1 then SelStart := CurPos + 2 else SelStart := CurPos + 1;
end;
if Keys = #8 then
begin
if (SelStart>Pos(Dsp,Text)) and (decimal>0) then
begin
Text:=copy(text,1,CurPos-1)+copy(text,CurPos+1,length(text))+'0';
SelStart := CurPos -1 ;
exit;
end;
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp1 := Sp1 + 1;
if (copy(text,CurPos,1)= Tsp) or (copy(text,CurPos,1)= Dsp) then
CurPos := CurPos -1;
Text := copy(text,1,CurPos-1)+copy(text,CurPos+1,length(text));
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp2 := Sp2 + 1;
if Sp2 = Sp1 then SelStart := CurPos - 1 else SelStart := CurPos - 2;
end;
if Keys = '-' then
begin
Value := -1* Value;
if Value < 0 then SelStart := CurPos + 1 else SelStart := CurPos - 1;
end;
if (Keys='.')or(Keys=',') then if Decimal<> 0 then SelStart:= Pos(Dsp,Text);
end;
{------------------------------------------------------------------------------}
procedure TFshEditFloat.KeyDown(var Key: Word; Shift: TShiftState);
var
CurPos, Sp1, Sp2, i , j:integer;
begin
inherited KeyDown(Key, Shift);
if key=46 then
begin
key:=0;
j :=1;
selstart := selstart + 1;
if (copy(text,selstart,1)=Tsp) or (copy(text,selstart,1)=Dsp) then
begin
selstart:=selstart+1;
j:=0
end;
curpos := selstart;
if (SelStart>Pos(Dsp,Text)) and (decimal>0) then
begin
Text:=copy(text,1,CurPos-1)+copy(text,CurPos+1,length(text))+'0';
SelStart := CurPos -1 ;
exit;
end;
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp1 := Sp1 + 1;
if (copy(text,CurPos,1)= Tsp) or (copy(text,CurPos,1)= Dsp) then
CurPos := CurPos -1;
Text := copy(text,1,CurPos-1)+copy(text,CurPos+1,length(text));
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp2 := Sp2 + 1;
if Sp2 = Sp1 then SelStart := CurPos - 1 else SelStart := CurPos - 2;
selstart := selstart + j;
exit;
end;
if (Key = 37) or (Key = 38) then
if copy(text,SelStart-1,1)=Tsp then SelStart := SelStart - 1;
if (Key = 39) or (Key = 40) then
if copy(text,SelStart+2,1)=Tsp then SelStart := SelStart + 1;
end;
{------------------------------------------------------------------------------}
procedure TFshEditFloat.DoExit;
begin
inherited DoExit;
text := formatfloat(msk,value);
end;
{------------------------------------------------------------------------------}
procedure TFshEditFloat.Change;
var
Er2 : real;
begin
inherited Change;
if (text = '') or
(not(TryStrToFloat(StringReplace(text, Tsp,'',[rfReplaceAll]),Er2)))then
begin
Value := 0;
Text := '';
end
else
begin
Value := strtofloat(StringReplace(text, Tsp, '', [rfReplaceAll]));
end;
end;
{------------------------------------------------------------------------------}
{ TFshEditCurrency }
{------------------------------------------------------------------------------}
procedure TFshEditCurrency.SetDecimal(const AValue: Integer);
begin
if Fdecimal = AValue then exit;
FDecimal := AValue;
if decimal = 0 then Msk:= ',0'+Money
else Msk:= ',0.'+ StringOfChar('0',Decimal)+Money;
Text := FormatFloat(Msk, Value);
end;
{------------------------------------------------------------------------------}
procedure TFshEditCurrency.SetMoney(const AValue: string);
begin
if FMoney=AValue then exit;
FMoney:=AValue;
if decimal = 0 then Msk:= ',0'+Money
else Msk:= ',0.'+ StringOfChar('0',Decimal)+Money;
Text := FormatFloat(Msk, Value);
end;
{------------------------------------------------------------------------------}
procedure TFshEditCurrency.SetValue(const AValue: Currency);
begin
if Fvalue = AValue then exit;
Fvalue := AValue;
Text := FormatFloat(Msk, Value);
end;
{------------------------------------------------------------------------------}
procedure TFshEditCurrency.DoExit;
begin
inherited DoExit;
text := formatfloat(msk,value);
end;
{------------------------------------------------------------------------------}
constructor TFshEditCurrency.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Alignment := taRightJustify;
Tsp := ThousandSeparator;
Dsp := DecimalSeparator;
Money := CurrencyString;
Msk := ',0'+Money;
Decimal := 0;
Text := '0'+Money;
Value := 0;
end;
{------------------------------------------------------------------------------}
procedure TFshEditCurrency.KeyPress(var Key: Char);
var
Keys : Char;
TmpStr : String;
Er1 : Currency;
CurPos, Sp1, Sp2, i : Integer;
begin
inherited KeyPress(Key);
Keys := Key ; Key := #0;
if not (Keys in ['0'..'9','-','.',',',#8]) then exit;
CurPos := SelStart;
if SelLength = Length(Text) then Text:= '';
Sp1 := 0; Sp2 := 0;
if (Keys in ['0'..'9']) then
begin
for i:=1 to length(Text) do if copy(Text, i, 1) = Tsp then Sp1 := Sp1+1;
TmpStr := copy(text,1,CurPos)+Keys+copy(text,CurPos+1,length(text));
TmpStr := StringReplace(TmpStr, Tsp, '', [rfReplaceAll]);
TmpStr := StringReplace(TmpStr, Money, '', [rfReplaceAll]);
if not (TryStrToCurr(TmpStr, Er1)) then exit;
Text := copy(text,1,CurPos)+Keys+copy(text,CurPos+1,length(text));
for i:=1 to length(Text) do if copy(Text, i, 1) = Tsp then Sp2 := Sp2+1;
if Sp2> Sp1 then SelStart := CurPos + 2 else SelStart := CurPos + 1;
end;
if Keys = #8 then
begin
if (SelStart>Pos(Dsp,Text)) and (decimal>0) then
begin
tmpstr:=copy(text,1,CurPos-1)+
copy(text,CurPos+1,length(text)-length(money))+'0';
tmpstr:=StringReplace(TmpStr, money, '', [rfReplaceAll]);
text := tmpstr+money;
SelStart := CurPos -1 ;
exit;
end;
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp1 := Sp1 + 1;
if (copy(text,CurPos,1)= Tsp) or (copy(text,CurPos,1)= Dsp) then
CurPos := CurPos -1;
Text := copy(text,1,CurPos-1)+copy(text,CurPos+1,length(text));
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp2 := Sp2 + 1;
if Sp2 = Sp1 then SelStart := CurPos - 1 else SelStart := CurPos - 2;
end;
if Keys = '-' then
begin
Value := -1* Value;
if Value < 0 then SelStart := CurPos + 1 else SelStart := CurPos - 1;
end;
if (Keys='.')or(Keys=',') then if Decimal<> 0 then SelStart:= Pos(Dsp,Text);
end;
{------------------------------------------------------------------------------}
procedure TFshEditCurrency.KeyDown(var Key: Word; Shift: TShiftState);
var
CurPos, Sp1, Sp2, i , j:integer;
tmpstr:string;
begin
inherited KeyDown(Key, Shift);
if key=46 then
begin
key:=0;
j :=1;
selstart := selstart + 1;
if (copy(text,selstart,1)=Tsp) or (copy(text,selstart,1)=Dsp) then
begin
selstart:=selstart+1;
j:=0
end;
curpos := selstart;
if (SelStart>Pos(Dsp,Text)) and (decimal>0) then
begin
tmpstr:=copy(text,1,CurPos-1)+
copy(text,CurPos+1,length(text)-length(money))+'0';
tmpstr:=StringReplace(TmpStr, money, '', [rfReplaceAll]);
text := tmpstr+money;
SelStart := CurPos -1 ;
exit;
end;
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp1 := Sp1 + 1;
if (copy(text,CurPos,1)= Tsp) or (copy(text,CurPos,1)= Dsp) then
CurPos := CurPos -1;
Text := copy(text,1,CurPos-1)+copy(text,CurPos+1,length(text));
for i:=1 to CurPos do if copy(Text, i, 1)= Tsp then Sp2 := Sp2 + 1;
if Sp2 = Sp1 then SelStart := CurPos - 1 else SelStart := CurPos - 2;
selstart := selstart + j;
exit;
end;
if (Key = 37) or (Key = 38) then
if copy(text,SelStart-1,1)=Tsp then SelStart := SelStart - 1;
if (Key = 39) or (Key = 40) then
if copy(text,SelStart+2,1)=Tsp then SelStart := SelStart + 1;
end;
{------------------------------------------------------------------------------}
procedure TFshEditCurrency.Change;
var
Er2 : Currency;
tmpst : string;
begin
inherited Change;
tmpst := StringReplace(text, Tsp,'',[rfReplaceAll]);
tmpst := StringReplace(tmpst, Money,'',[rfReplaceAll]);
if (text = '') or (not(TryStrToCurr(tmpst,Er2)))then
begin
Value := 0;
Text := '';
end
else
begin
Value := strtofloat(tmpst);
end;
end;
{------------------------------------------------------------------------------}
{******************************************************************************}
{********************* Function ***********************************************}
{******************************************************************************}
function TextMargins(Editor: tFshEditCustom): TPoint;
var
DC : HDC;
SaveFont : HFont;
I : Integer;
SysMetrics, Metrics: TTextMetric;
begin
with Editor do
begin
if NewStyleControls then
begin
if BorderStyle = bsNone then I := 0 else I := 2;
Result.X := I;
Result.Y := I;
end
else
begin
if BorderStyle = bsNone then I := 0 else
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
I := I div 4;
end;
Result.X := I;
Result.Y := I;
end;
end;
end;
{******************************************************************************}
function SrPaint(Editor: tFshEditCustom; const AText: string;
AAlignment: TAlignment; StdPaint: Boolean; var ACanvas: TControlCanvas;
var Message: TLMPaint): Boolean;
var
AWidth, ALeft: Integer;
Margins : TPoint;
R : TRect;
DC : HDC;
PS : TPaintStruct;
S : string;
begin
Result := True;
with Editor do
begin
if StdPaint and not(csPaintCopy in ControlState) then
begin
Result := False;
Exit;
end;
if ACanvas = nil then
begin
ACanvas := TControlCanvas.Create;
ACanvas.Control := Editor;
end;
DC := Message.DC;
if DC = 0 then DC := BeginPaint(Handle, PS);
ACanvas.Handle := DC;
try
ACanvas.Font := Font;
if not Enabled and NewStyleControls and not
(csDesigning in ComponentState) and
(ColorToRGB(Color) <> ColorToRGB(clGrayText)) then
ACanvas.Font.Color := clGrayText;
with ACanvas do
begin
R := ClientRect;
if not (NewStyleControls) and (BorderStyle = bsSingle) then
begin
Brush.Color := clWindowFrame;
end;
Brush.Color := Color;
S := AText;
AWidth := TextWidth(S);
Margins := TextMargins(Editor);
case AAlignment of
taLeftJustify : ALeft := Margins.x;
taRightJustify: ALeft := ClientWidth - AWidth - Margins.X - 2;
else ALeft := (ClientWidth - AWidth) div 2;
end;
TextRect(R, ALeft, Margins.Y-2, S);
end;
finally
ACanvas.Handle := 0;
if Message.DC = 0 then EndPaint(Handle, PS);
end;
end;
end;
{******************************************************************************}
initialization
//{$I fsheditres.lrs}
end.