TEdit, TSpinEdit

Code:

procedure TForm1.Edit1Exit(Sender: TObject);

begin

if Edit1.Text <> '' then

begin

   try

     StrToDate(Edit1.Text);

   except

     Edit1.SetFocus;

     MessageBeep(0);

     raise Exception.Create('"' + Edit1.Text

       + '" - некорректная дата');

   end {try};

   Edit1.Text := DateToStr(StrToDate(Edit1.Text));

end {if};

end;

Code:

{Question:

How can I change the color of a disabled (Edit1.Enabled := false;) control?

I do not want the normal grey color.

Answer:

Two options:

1) place the control on a panel and disable the panel instead of the control.

This way the color stays to whatever you set it.

2) make a descendent and take over the painting when it is disabled.

Here is an example:}

unit PBExEdit;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls,

  Forms, Dialogs, StdCtrls;

type

  TPBExEdit = class(TEdit)

  private

    { Private declarations }

    FDisabledColor: TColor;

    FDisabledTextColor: TColor;

    procedure WMPaint(var msg: TWMPaint); message WM_PAINT;

    procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;

    procedure SetDisabledColor(const Value: TColor); virtual;

    procedure SetDisabledTextColor(const Value: TColor); virtual;

  protected

    { Protected declarations }

  public

    { Public declarations }

    constructor Create(aOwner: TComponent); 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('PBGoodies', [TPBExEdit]);

end;

constructor TPBExEdit.Create(aOwner: TComponent);

begin

  inherited;

  FDisabledColor := clWindow;

  FDisabledTextColor := clGrayText;

end;

procedure TPBExEdit.SetDisabledColor(const Value: TColor);

begin

  if FDisabledColor <> Value then

  begin

    FDisabledColor := Value;

    if not Enabled then

      Invalidate;

  end;

end;

procedure TPBExEdit.SetDisabledTextColor(const Value: TColor);

begin

  if FDisabledTextColor <> Value then

  begin

    FDisabledTextColor := Value;

    if not Enabled then

      Invalidate;

  end;

end;

procedure TPBExEdit.WMEraseBkGnd(var msg: TWMEraseBkGnd);

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 TPBExEdit.WMPaint(var msg: TWMPaint);

var

  Canvas: TCanvas;

  ps: TPaintStruct;

  CallEndPaint: Boolean;

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(WM_ERASEBKGND, Canvas.Handle, 0);

      SaveDC(canvas.handle);

      try

        Canvas.Brush.Style := bsClear;

        Canvas.Font := Font;

        Canvas.Font.Color := FDisabledTextColor;

        Canvas.TextOut(1, 1, Text);

      finally

        RestoreDC(Canvas.Handle, - 1);

      end;

    finally

      if CallEndPaint then

        EndPaint(handle, ps);

      Canvas.Free

    end;

  end;

end;

end.

Code:

type

{©Drkb v.3(2007): www.drkb.ru}

TNumEdit = class(TEdit)

   procedure CreateParams(var Params: TCreateParams); override;

.......

procedure TNumEdit.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

Params.Style := Params.Style or ES_MULTILINE or ES_RIGHT;

end;

Code:

uses Clipbrd;

function NewEditProc(wnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):integer; stdcall;

var

s:string;

i:integer;

begin

if (uMsg=WM_PASTE) and Clipboard.HasFormat(CF_TEXT) then

begin

s := Clipboard.AsText;

for i:=1 to Length(s) do if (not (s[i] in ['0'..'9'])) then begin uMsg:=0; break end

end;

result:=CallWindowProc(Pointer(GetWindowLong(wnd,GWL_USERDATA)),wnd,uMsg,wParam,lParam)

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

SetWindowLong(Edit1.Handle,GWL_STYLE,GetWindowLong(Edit1.Handle,GWL_STYLE) or ES_NUMBER);

SetWindowLong(Edit1.Handle,GWL_USERDATA,SetWindowLong(Edit1.Handle, GWL_WNDPROC, LPARAM(@NewEditProc)))

end;

Code:

unit CurrEdit;

interface

uses

SysUtils,

WinTypes,

WinProcs,

Messages,

Classes,

Graphics,

Controls,

Menus,

Forms,

Dialogs,

StdCtrls;

type

TCurrencyEdit = class(TCustomMemo)

private

   DispFormat: string;

   FieldValue: Extended;

   procedure SetFormat(A: string);

   procedure SetFieldValue(A: Extended);

   procedure CMEnter(var Message: TCMEnter); message CM_ENTER;

   procedure CMExit(var Message: TCMExit); message CM_EXIT;

   procedure FormatText;

   procedure UnFormatText;

protected

   procedure KeyPress(var Key: Char); override;

   procedure CreateParams(var Params: TCreateParams); override;

public

   constructor Create(AOwner: TComponent); override;

published

   property Alignment default taRightJustify;

   property AutoSize default True;

   property BorderStyle;

   property Color;

   property Ctl3D;

   property DisplayFormat: string read DispFormat write SetFormat;

   property DragCursor;

   property DragMode;

   property Enabled;

   property Font;

   property HideSelection;

   property MaxLength;

   property ParentColor;

   property ParentCtl3D;

   property ParentFont;

   property ParentShowHint;

   property PopupMenu;

   property ReadOnly;

   property ShowHint;

   property TabOrder;

   property Value: Extended read FieldValue write SetFieldValue;

   property Visible;

   property OnChange;

   property OnClick;

   property OnDblClick;

   property OnDragDrop;

   property OnDragOver;

   property OnEndDrag;

   property OnEnter;

   property OnExit;

   property OnKeyDown;

   property OnKeyPress;

   property OnKeyUp;

   property OnMouseDown;

   property OnMouseMove;

   property OnMouseUp;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Additional', [TCurrencyEdit]);

end;

constructor TCurrencyEdit.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

AutoSize := True;

Alignment := taRightJustify;

Width := 121;

Height := 25;

DispFormat := '$,0.00;($,0.00)';

FieldValue := 0.0;

AutoSelect := False;

WantReturns := False;

WordWrap := False;

FormatText;

end;

procedure TCurrencyEdit.SetFormat(A: string);

begin

if DispFormat <> A then

begin

   DispFormat := A;

   FormatText;

end;

end;

procedure TCurrencyEdit.SetFieldValue(A: Extended);

begin

if FieldValue <> A then

begin

   FieldValue := A;

   FormatText;

end;

end;

procedure TCurrencyEdit.UnFormatText;

var

TmpText: string;

Tmp: Byte;

IsNeg: Boolean;

begin

IsNeg := (Pos('-', Text) > 0) or (Pos('(', Text) > 0);

TmpText := '';

for Tmp := 1 to Length(Text) do

   if Text[Tmp] in ['0'..'9', '.'] then

     TmpText := TmpText + Text[Tmp];

try

   FieldValue := StrToFloat(TmpText);

   if IsNeg then

     FieldValue := -FieldValue;

except

   MessageBeep(mb_IconAsterisk);

end;

end;

procedure TCurrencyEdit.FormatText;

begin

Text := FormatFloat(DispFormat, FieldValue);

end;

procedure TCurrencyEdit.CMEnter(var Message: TCMEnter);

begin

SelectAll;

inherited;

end;

procedure TCurrencyEdit.CMExit(var Message: TCMExit);

begin

UnformatText;

FormatText;

inherited;

end;

procedure TCurrencyEdit.KeyPress(var Key: Char);

begin

if not (Key in ['0'..'9', '.', '-']) then

   Key := #0;

inherited KeyPress(Key);

end;

procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

case Alignment of

   taLeftJustify: Params.Style := Params.Style or ES_LEFT and not ES_MULTILINE;

   taRightJustify: Params.Style := Params.Style or ES_RIGHT and not

     ES_MULTILINE;

   taCenter: Params.Style := Params.Style or ES_CENTER and not ES_MULTILINE;

end;

end;

end.

Code:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if ((UpCase(Key) < 'A') or (UpCase(Key) > 'Z')) then Key := #0;

end;