[[José Luis Garcí]]

Y su equivalente sin bases de datos

Código Delphi [-]
{ ****************************************************************** }
{                                                                    }
{   VCL component TMyNewEditJL                                         }
{                                                                    }
{   Code generated by Component Create for Delphi                    }
{                                                                    }
{   Generated from untitled component definition                     }
{   on 25 May 2013 at 11:52                                          }
{                                                                    }
{   Copyright © 201 by J.L.G.T.3                                     }
{                                                                    }
{ ****************************************************************** }

unit Mneweditjl;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
     Forms, Graphics, Stdctrls, Dialogs, Windows;

type
  TBorderStyle = (bsNone, bsSingle, bsRound);

  TMyNewEditJL = class(TEdit)
    private
        FColorFocused : TColor;
        FOnlyNumbersDouble : Boolean;
        FOnlyDate  : Boolean;
        FFillToEnterDate: Boolean;
        FTextDefault : String;
        FAlignment: TAlignment;
        FBorderStyle: TBorderStyle;
        FBorderColor: TColor;
        FBorderRadio: Integer;
        FBorderThick: Integer;
        FIncrouble;
        FEnterTab:Boolean;
        FMaxLenghTab:Boolean;
        FMatchHintAndDefault: Boolean;
        procedure SetMatchHintAndDefault(Value:Boolean);
        procedure SetBorderThick(Value:Integer);
        procedure SetIncr(Value: Double);
        procedure SetEnterTab(Value: boolean);
        procedure SetMaxLenghTab(Value: boolean);
        procedure SetBorderColor(Color: TColor);
        procedure SetBorderRadio(Radio: integer);
        procedure SetBorderStyle(Value: TBorderStyle);
        procedure SetRound(Value: boolean);
        procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
        procedure SetOnlyDate (Value : Boolean);
        procedure SetFillToEnterDate(Value : Boolean);
        procedure SetAlignment(Value: TAlignment);
        procedure AutoInitialize;
        procedure AutoDestroy;
        procedure SetColorFocused(Value : TColor);
        procedure SetOnlyNumbersDouble(Value : Boolean);
        procedure SetTextDefault(Value : String);
        procedure WMSize(var Message: TWMSize); message WM_SIZE;
        var VarCColor:Tcolor;
    protected
        procedure CreateWnd; override;
        procedure Change; override;
        procedure Click; override;
        procedure KeyPress(var Key : Char); override;
        procedure Loaded; override;
        procedure CreateParams(var Params: TCreateParams); override;
        procedure DoExit; override;
        procedure DoEnter; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
    published
        property Text;
        property TextHint;
        property OnChange;
        property OnDblClick;
        property OnDragDrop;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property ColorFocused : TColor read FColorFocused write SetColorFocused default clSkyBlue;
        property OnlyNumbersDouble : Boolean read FOnlyNumbersDouble write SetOnlyNumbersDouble default False;
        property TextDefault : String read FTextDefault write SetTextDefault;
        property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
        property FillToEnterDate: Boolean read FFillToEnterDate write SetFillToEnterDate default False;
        property OnlyDate: Boolean read FOnlyDate write SetOnlyDate default False;
        property BorderColor: TColor  read FBorderColor write SetBorderColor default clNavy;
        property BorderRadio: Integer read FBorderRadio write SetBorderRadio default 5;
        property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; //default bsRound;
        property Incr: Double read FIncr write SetIncr;
        property EnterTab: Boolean read FEnterTab write SetEnterTab default False;
        property MaxLenghTab: Boolean read FMaxLenghTab write SetMaxLenghTab default False;
        property BorderThick: Integer read FBorderThick write SetBorderThick default 1;
        property MatchHintAndDefault: Boolean read FMatchHintAndDefault write setMatchHintAndDefault default True;
end;

procedure Register;

implementation


procedure Register;
begin
     RegisterComponents('Standard', [TMyNewEditJL]);
end;

procedure TMyNewEditJL.AutoInitialize;
begin
     FColorFocused := clSkyBlue;
     FOnlyNumbersDouble := False;
     FAlignment:=taLeftJustify;
     FBorderColor:= clNavy;
     FBorderRadio:= 5;
     FBorderStyle:= bsRound;
     FOnlyDate  :=false;
     FFillToEnterDate:=True;
     FTextDefault :='';
     FIncr:=0.01;
     FMaxLenghTab:=True;
     FEnterTab:=False;
     FBorderThick:=1;
     FMatchHintAndDefault:=True;
end; { of AutoInitialize }

procedure TMyNewEditJL.AutoDestroy;
begin
   {}
end; { of AutoDestroy }

procedure TMyNewEditJL.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    RecreateWnd;
  end;
end;

procedure TMyNewEditJL.SetColorFocused(Value : TColor);
begin
     FColorFocused := Value;
end;

procedure TMyNewEditJL.SetEnterTab(Value: boolean);
begin
  if FEnterTab<>value then FEnterTab:=Value;
end;

procedure TMyNewEditJL.SetFillToEnterDate(Value: Boolean);
begin
    if FFillToEnterDate<>value then FFillToEnterDate:=Value;
end;

procedure TMyNewEditJL.SetIncr(Value: Double);
begin
   if FIncr<>Value then FIncr:=Value;
end;

procedure TMyNewEditJL.SetMatchHintAndDefault(Value: Boolean);
begin
    if fMatchHintAndDefault<>value then FMatchHintAndDefault:=Value;
end;

procedure TMyNewEditJL.SetMaxLenghTab(Value: boolean);
begin
   if FMaxLenghTab<>Value then FMaxLenghTab:=value;
end;

procedure TMyNewEditJL.SetOnlyDate(Value: Boolean);
begin
   if FOnlyDate<>value then
   begin
     if (FOnlyNumbersDouble) and (Value=true) then FOnlyNumbersDouble:=False;
     FOnlyDate:=Value;
   end;
end;

procedure TMyNewEditJL.SetOnlyNumbersDouble(Value : Boolean);
begin
   if FOnlyNumbersDouble<>value then
   begin
     if (FOnlyDate) and (Value=true) then FOnlyDate:=False;
     if Value=true then Alignment:=taRightJustify else Alignment:=taLeftJustify;
     FOnlyNumbersDouble:=Value;
   end;
end;

procedure TMyNewEditJL.SetTextDefault(Value : String);
begin
     FTextDefault := Value;
end;

procedure TMyNewEditJL.Change;
begin
     inherited Change;
     if FMaxLenghTab then
     begin
       if (Length(Text)>=MaxLength) and (MaxLength<>0) and (Self.Focused) then keybd_event(VK_TAB ,0,0,0); //Pulsa el tab por código
     end;
end;

procedure TMyNewEditJL.Click;
begin
     inherited Click;
end;

procedure TMyNewEditJL.KeyDown(var Key: Word; Shift: TShiftState);
var Numerouble;
begin
  if FOnlyDate then
  begin
     if (Key=VK_UP) then text:=DateToStr(StrToDate(Self.Text)+1);  //Añadimos  díaa
     if (Key=VK_DOWN) then Text:=DateToStr(StrToDate(Self.Text)+1);//Disminuimos  días
     Key := 0;
  end;
  if FOnlyNumbersDouble then
  begin
     Numer:=StrToFloat(Text);
     if (Key=VK_UP) then Numer:=numer+FIncr;
     if (Key=VK_DOWN) then Numer:=Numer-FIncr;
     if Numer>=0 then Text:=FloatToStr(Numer)
                 else text:='-'+FloatToStr(Numer);
     Key := 0;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TMyNewEditJL.KeyPress(var Key : Char);
const TabKey = Char(VK_TAB);
      EnterKey = Char(VK_RETURN);
begin
   if FOnlyNumbersDouble then
   begin
     if Key='.' then Key:=',';  //Para los Decimales
     if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
     begin
        ShowMessage('Tecla no valida: ' + Key);
        Key := #0;
     end else if ((Key = DecimalSeparator) or (Key = '-') or (Key=',') or (Key = #8 )) and (Pos(Key, Self.Text) > 0) then
     begin
        ShowMessage('Tecla no valida: (por repetida) ' + Key);
        Key := #0;
     end else if (Key = '-') and (Self.SelStart <> 0) then
     begin
        ShowMessage('Sólo se permite numeros: ' + Key);
        Key := #0;
     end;
   end;
   If Key = #13 Then
   Begin
      if FEnterTab then
      begin
        keybd_event(VK_TAB ,0,0,0); //Pulsa el Tab por código
        Key := #0
      end;
   end;
   inherited KeyPress(Key);
end;

constructor TMyNewEditJL.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     AutoInitialize;
end;

procedure TMyNewEditJL.CreateParams(var Params: TCreateParams);
const
  Alignments : array[TAlignment] of LongWord= (ES_Left,ES_Right, ES_Center);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or Alignments[FAlignment];
end;

destructor TMyNewEditJL.Destroy;
begin
     AutoDestroy;
     inherited Destroy;
end;

procedure TMyNewEditJL.Loaded;
begin
     inherited Loaded;
end;

procedure TMyNewEditJL.DoEnter;
begin
  inherited;
  VarCColor:=Self.Color;
  SElf.Color:=fcolorFocused;
  if (FOnlyDate) and (FillToEnterDate) then Self.Text:=DateToStr(Now);
end;

procedure TMyNewEditJL.DoExit;
begin
  self.Color:=VarCColor;
  if (self.text='') and (FOnlyNumbersDouble=False) and (FOnlyDate=false) then self.text:=ftextDefault;
  if (FOnlyNumbersDouble) and (Self.Text='') then Self.Text:='0';
  if (FOnlyDate) and (Self.Text='') then Self.Text:=DateToStr(Now);
  inherited;
end;

//todo esto es cogido del compañero Escafandra de su componente RoundEdit--------------------------

procedure TMyNewEditJL.CreateWnd;
begin
  inherited CreateWnd;
  SetRound(FBorderStyle = bsRound);
end;


procedure TMyNewEditJL.SetRound(Value: boolean);
var
  Rgn: HRGN;
begin
  Rgn:= 0;
  if Value then
    Rgn := CreateRoundRectRgn(0, 0, Width+1, Height+1, FBorderRadio-2, FBorderRadio-2) ;
  SetWindowRgn(Handle, Rgn, true);
  DeleteObject(Rgn);
end;

procedure TMyNewEditJL.SetBorderColor(Color: TColor);
begin
  FBorderColor:= Color;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  Invalidate;
end;


procedure TMyNewEditJL.SetBorderRadio(Radio: integer);
begin
  if Radio <= 10 then
  begin
    FBorderRadio:= Radio;
    SetRound(true);
    RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  end;
end;

procedure TMyNewEditJL.SetBorderStyle(Value: TBorderStyle);
begin
  if Value <> FBorderStyle then
  begin
    FBorderStyle:= Value;
    SetRound(false);
    inherited Ctl3D:= Ctl3D;
    case Value of
      bsNone:   inherited BorderStyle := Forms.TBorderStyle(bsNone);
      bsSingle: inherited BorderStyle := Forms.TBorderStyle(bsSingle);
      bsRound:
      begin
        inherited BorderStyle := Forms.TBorderStyle(bsSingle);
        inherited Ctl3D:= true;
        SetRound(true);
      end;
    end;
    RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  end;
end;


procedure TMyNewEditJL.SetBorderThick(Value: Integer);
begin
   if FBorderThick<>value then FBorderThick:=Value;       //añadido por mi
end;

procedure TMyNewEditJL.WMNCPaint(var Message: TMessage);
var
  Brush: TBrush;
  Pen: TPen;
  DC: HDC;
  Clip: integer;
begin
  if (BorderStyle <> bsRound) or not inherited Ctl3D then
  begin
    inherited;
      exit;
  end;

  DC:= GetWindowDC(Handle);
  Brush:= TBrush.Create;
  Pen:= TPen.Create;
  Pen.Color:= BorderColor;
  Pen.Width:=FBorderThick;  //añadido por mi
  Brush.Color:= Color;

  ExcludeClipRect(DC, 4, 4, Width-4, Height-4);
  Windows.SelectObject(DC, Brush.Handle);
  Windows.SelectObject(DC, Pen.Handle);

  Windows.Rectangle(DC, 0, 0, Width, Height);
  Brush.Style:= bsClear;
  Windows.RoundRect(DC, 0, 0, Width, Height,  FBorderRadio, FBorderRadio);

  Windows.ReleaseDC(Handle, DC);
  Brush.Destroy;
  Pen.Destroy;
end;

procedure TMyNewEditJL.WMSize(var Message: TWMSize);
var r : TRect;
begin
   inherited;
   r := ClientRect;
   SetRound(True);
   InvalidateRect(handle,@r,false);
   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

end.