PDA

Ver la Versión Completa : Problema al agrandar este nuevo componente

José Luis Garcí
30-05-2013, 14:15:25
Hola compañeros, como siempre haber si podéis echarme una mano con este componente, que por culpa de el (llevo cuatro días intentando buscar una solución y por un error en un archivo DFM, no he podido seguir con el tema de programa de gestión desde 0.

El problema es el siguiente, pongo el componente y bien, en cuanto lo alargamos en tamaño, se ve la parte que estaba visible pero la nueva parte no, lo ejecuto y se ve completamente, pero por si algún motivo lo alargamos en ejecución pasa lo mismo.

Os pongo el código

{ ****************************************************************** }
{ }
{ VCL component TDBNewEditJL }
{ }
{ 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 DBneweditjl;

interface

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

type
TBorderStyle = (bsNone, bsSingle, bsRound);

TDBNewEditJL = class(TEdit)
private
FColorFocused : TColor;
FOnlyNumbersDouble : Boolean;
FOnlyDate : Boolean;
FFillToEnterDate: Boolean;
FTextDefault : String;
FAlignment: TAlignment;
FBorderStyle: TBorderStyle;
FBorderColor: TColor;
FBorderRadio: Integer;
FDataLink : TFieldDataLink;
FBorderThick: Integer;
FIncr:Double;
FEnterTab:Boolean;
FMaxLenghTab:Boolean;
procedure SetEnterTab(Value: boolean);
function GetDataSource : TDataSource;
function GetDataField : String;
procedure SetDataField(Value : String);
procedure SetBorderThick(Value:Integer);
procedure SetIncr(Value: Double);
procedure SetMaxLenghTab(Value: boolean);
procedure SetDataSource(Value : TDataSource);
procedure ActiveChange(Sender : TObject);
procedure DataChange(Sender : TObject);
procedure EditingChange(Sender : TObject);
procedure UpdateData(Sender : TObject);
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 WMSize(var Message: TWMSize); message WM_SIZE;
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 FOnResized(Sender: TObject);
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 OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
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 DataField : String read GetDataField write SetDataField;
property DataSource : TDataSource read GetDataSource write SetDataSource;
property Incr: Double read FIncr write SetIncr;
property MaxLenghTab: Boolean read FMaxLenghTab write SetMaxLenghTab default False;
property BorderThick: Integer read FBorderThick write SetBorderThick default 1;
property EnterTab: Boolean read FEnterTab write SetEnterTab default False;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Data Controls', [TDBNewEditJL]);
end;

procedure TDBNewEditJL.AutoInitialize;
begin
FColorFocused := clSkyBlue;
FOnlyNumbersDouble := False;
FAlignment:=taLeftJustify;
FBorderColor:= clNavy;
FBorderRadio:= 5;
FBorderStyle:= bsRound;
FOnlyDate :=false;
FFillToEnterDate:=True;
FTextDefault :='';
FDataLink := TFieldDataLink.Create;
with FDataLink do
begin
{ Assign handlers }
OnDataChange := DataChange;
OnUpdateData := UpdateData;
OnEditingChange := EditingChange;
OnActiveChange := ActiveChange;
end;
FIncr:=0.01;
FMaxLenghTab:=True;
FBorderThick:=1;
FEnterTab:=False;
OnResize := FOnResized;
end; { of AutoInitialize }

procedure TDBNewEditJL.AutoDestroy;
begin
FDataLink.Free;
end; { of AutoDestroy }

function TDBNewEditJL.GetDataField : String;
begin
Result := FDataLink.FieldName;
end;

procedure TDBNewEditJL.SetDataField(Value : String);
begin
FDataLink.FieldName := Value;
end;

function TDBNewEditJL.GetDataSource : TDataSource;
begin
Result := FDataLink.DataSource;
end;

procedure TDBNewEditJL.SetDataSource(Value : TDataSource);
begin
FDataLink.DataSource := Value;
end;


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

procedure TDBNewEditJL.ActiveChange(Sender : TObject);
const IntFieldTypes = [ftSmallInt, ftInteger, ftWord];
begin
if DataField = '' then Exit;
if FDataLink <> nil then
if FDataLink.Dataset <> nil then
if FDataLink.Dataset.Active then Text:=FDataLink.Field.AsString;
// raise EDatabaseError.Create('Wrong field type');
end;

procedure TDBNewEditJL.DataChange(Sender : TObject);
begin
if FDataLink.Field = nil then
begin

end
else
begin
Text:=FDataLink.Field.AsString;
{ Update component using properties of FDataLink.Field }
end
end;

procedure TDBNewEditJL.UpdateData(Sender : TObject);
begin
{ Respond to OnUpdateData events of FDataLink }
Text:=FDataLink.Field.AsString;
end;

procedure TDBNewEditJL.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecreateWnd;
end;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetColorFocused(Value : TColor);
begin
FColorFocused := Value;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetFillToEnterDate(Value: Boolean);
begin
if FFillToEnterDate<>value then FFillToEnterDate:=Value;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetIncr(Value: Double);
begin
if FIncr<>Value then FIncr:=Value;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetMaxLenghTab(Value: boolean);
begin
if FMaxLenghTab<>Value then FMaxLenghTab:=value;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetOnlyDate(Value: Boolean);
begin
if FOnlyDate<>value then
begin
if (FOnlyNumbersDouble) and (Value=true) then FOnlyNumbersDouble:=False;
FOnlyDate:=Value;
end;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.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;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.EditingChange(Sender : TObject);
begin
{ Respond to OnEditingChange events of FDataLink }
{ The data source has gone from editing to non-editing,
or the reverse; update the component's properties
based on the value of FDataLink.Editing. }
{ ReadOnly := not FDataLink.Editing; }
{ . . . if the component has a ReadOnly property, or . . . }
{ Enabled := not FDataLink.Editing; }
if FDataLink.DataSet.State in [dsEdit, dsInsert] then
begin
if OnlyDate then FDataLink.Field.Value:=StrToDate(Text)
else if OnlyNumbersDouble then FDataLink.Field.Value:=StrToFloat(text)
else FDataLink.Field.Value:=Text;
end;
end;

procedure TDBNewEditJL.FOnResized(Sender: TObject);
begin
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetTextDefault(Value : String);
begin
if FTextDefault<>Value then FTextDefault := Value;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.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 TDBNewEditJL.Click;
begin
inherited Click;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.KeyDown(var Key: Word; Shift: TShiftState);
var Numer:Double;
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 TDBNewEditJL.KeyPress(var Key : Char);
const TabKey = Char(VK_TAB);
EnterKey = Char(VK_RETURN);
begin
if FOnlyNumbersDouble then
begin
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=',')) 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 TDBNewEditJL.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoInitialize;
end;

procedure TDBNewEditJL.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 TDBNewEditJL.Destroy;
begin
AutoDestroy;
inherited Destroy;
end;

procedure TDBNewEditJL.Loaded;
begin
inherited Loaded;
end;

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

procedure TDBNewEditJL.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 TDBNewEditJL.CreateWnd;
begin
inherited CreateWnd;
SetRound(FBorderStyle = bsRound);
end;


procedure TDBNewEditJL.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 TDBNewEditJL.SetBorderColor(Color: TColor);
begin
FBorderColor:= Color;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
Invalidate;
end;


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

procedure TDBNewEditJL.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 TDBNewEditJL.SetBorderThick(Value: Integer);
begin
if FBorderThick<>value then FBorderThick:=Value; //añadido por mi
end;

procedure TDBNewEditJL.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 TDBNewEditJL.WMSize(var Message: TWMSize);
var r : TRect;
begin
inherited;
r := ClientRect;
InvalidateRect(handle,@r,false);
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

end.

LA imagen

http://nsae01.casimages.net/img/2013/05/30/130530012928597175.jpg (http://www.casimages.es/i/130530012928597175.jpg.html)


he marcado en rojo para que veais el fallo.
y por el último el archivo
José Luis Garcí
30-05-2013, 14:19:20
El archivo, donde tendre la cabeza
beginner01
30-05-2013, 19:53:58
Hola.

Por lo que pude leer aquí (http://msdn.microsoft.com/en-us/library/aa930600.aspx), el problema se presenta por el uso de SetWindowRgn, ya que este impide que se vea o dibuje la ventana
mas allá de el área designada por la misma.


This function sets the window region of a window. The window region determines the area within the window where the system permits drawing.
The system does not display any portion of a window that lies outside of the window region.

Para solucionar este problema debes de cambiar el tamaño de la región acorde con el nuevo tamaño del componente.

realicé una prueba con el componente cambiando:

procedure TDBNewEditJL.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;

Lo cual evita que se produzca el efecto que comentas.
José Luis Garcí
30-05-2013, 20:49:04
Muchas gracias beginner01, funciono perfectamente. Pasate poor la taberna que te he dejado una ronda paga.:D:D
beginner01
30-05-2013, 21:55:05
Muchas gracias beginner01, funciono perfectamente. Pasate poor la taberna que te he dejado una ronda paga.:D:D

Me parece bien. :D :D
José Luis Garcí
01-06-2013, 14:54:11
Hola compañeros, al final he tenido que hacer algunos cambio y aquí os pongo el código definitivo, del componente

{ ****************************************************************** }
{ }
{ VCL component TDBNewEditJL }
{ }
{ 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 DBneweditjl;

interface

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

type
TBorderStyle = (bsNone, bsSingle, bsRound);

TDBNewEditJL = class(TDBEdit)
private
FColorFocused : TColor;
FOnlyNumbersDouble : Boolean;
FOnlyDate : Boolean;
FFillToEnterDate: Boolean;
FTextDefault : String;
FAlignment: TAlignment;
FBorderStyle: TBorderStyle;
FBorderColor: TColor;
FBorderRadio: Integer;
FDataLink : TFieldDataLink;
FBorderThick: Integer;
FIncr:Double;
FEnterTab:Boolean;
FMaxLenghTab:Boolean;
FMatchHintAndDefault: Boolean;
procedure SetMatchHintAndDefault(Value:Boolean);
procedure SetEnterTab(Value: boolean);
procedure SetBorderThick(Value:Integer);
procedure SetIncr(Value: Double);
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 WMSize(var Message: TWMSize); message WM_SIZE;
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 FOnResized(Sender: TObject);
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 OnClick;
property OnDblClick;
property OnDragDrop;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
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 MaxLenghTab: Boolean read FMaxLenghTab write SetMaxLenghTab default False;
property BorderThick: Integer read FBorderThick write SetBorderThick default 1;
property EnterTab: Boolean read FEnterTab write SetEnterTab default False;
property MatchHintAndDefault: Boolean read FMatchHintAndDefault write setMatchHintAndDefault default True;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Data Controls', [TDBNewEditJL]);
end;

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

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


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

procedure TDBNewEditJL.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecreateWnd;
end;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetColorFocused(Value : TColor);
begin
FColorFocused := Value;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetFillToEnterDate(Value: Boolean);
begin
if FFillToEnterDate<>value then FFillToEnterDate:=Value;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetIncr(Value: Double);
begin
if FIncr<>Value then FIncr:=Value;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

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

procedure TDBNewEditJL.SetMaxLenghTab(Value: boolean);
begin
if FMaxLenghTab<>Value then FMaxLenghTab:=value;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetOnlyDate(Value: Boolean);
begin
if FOnlyDate<>value then
begin
if (FOnlyNumbersDouble) and (Value=true) then FOnlyNumbersDouble:=False;
FOnlyDate:=Value;
end;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.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;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;


procedure TDBNewEditJL.FOnResized(Sender: TObject);
begin
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetTextDefault(Value : String);
begin
if FTextDefault<>Value then FTextDefault := Value;
if fMatchHintAndDefault then Self.TextHint:=Value;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.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 TDBNewEditJL.Click;
begin
inherited Click;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.KeyDown(var Key: Word; Shift: TShiftState);
var Numer:Double;
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 TDBNewEditJL.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
//#8= backSpace, #13= Enter, #25= LeftArrow, #274= RightArrow
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 TDBNewEditJL.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoInitialize;
end;

procedure TDBNewEditJL.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 TDBNewEditJL.Destroy;
begin
AutoDestroy;
inherited Destroy;
end;

procedure TDBNewEditJL.Loaded;
begin
inherited Loaded;
end;

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

procedure TDBNewEditJL.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 TDBNewEditJL.CreateWnd;
begin
inherited CreateWnd;
SetRound(FBorderStyle = bsRound);
end;


procedure TDBNewEditJL.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 TDBNewEditJL.SetBorderColor(Color: TColor);
begin
FBorderColor:= Color;
RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
Invalidate;
end;


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

procedure TDBNewEditJL.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 TDBNewEditJL.SetBorderThick(Value: Integer);
begin
if FBorderThick<>value then FBorderThick:=Value; //añadido por mi
end;

procedure TDBNewEditJL.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 TDBNewEditJL.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.
José Luis Garcí
01-06-2013, 14:55:04
Y su equivalente sin bases de datos

{ ****************************************************************** }
{ }
{ 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;
FIncr:Double;
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 Numer:Double;
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.