Detectado javascript desactivado

Tienes el javascript desactivado en este momento. Muchas funciones podrían no funcionar. Por favor reactiva el javascript para obtener una funcionalidad completa.

Problema al agrandar este nuevo componente

Comenzado por Desart , may 30 2013 05:46

Por favor identifícate para responder

5 respuestas en este tema

#1 Desart

Advanced Member

Miembro Platino
715 mensajes

LocationEspaña

Escrito 30 mayo 2013 - 05:46

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

delphi

{ ****************************************************************** }
{                                                                    }
{   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

he marcado en rojo para que veais el fallo.

y por el último el archivo

Volver arriba

#2 Desart

Advanced Member

Miembro Platino
715 mensajes

LocationEspaña

Escrito 30 mayo 2013 - 12:23

Pues gracias al compañero beginner01 del Clubdelphi que me respondió y logro que se solucionara el problema, pongo aqui su respuesta y doy el tema por resuelto

delphi

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;

Volver arriba

#3 poliburro

Advanced Member

Administrador
4.945 mensajes

LocationMéxico

Escrito 30 mayo 2013 - 12:27

Pues gracias al compañero beginner01 del Clubdelphi que me respondió y logro que se solucionara el problema, pongo aqui su respuesta y doy el tema por resuelto

Gracias por compartirnos la solución amigo. Saludos

Volver arriba

#4 Desart

Advanced Member

Miembro Platino
715 mensajes

LocationEspaña

Escrito 01 junio 2013 - 06:38

Hola compañeros, al final he tenido que hacer algunos cambio y aquí os pongo el código definitivo, del componente

delphi

{ ****************************************************************** }
{                                                                    }
{   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;
        FIncrouble;
        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 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 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.

Volver arriba

#5 Desart

Advanced Member

Miembro Platino
715 mensajes

LocationEspaña

Escrito 01 junio 2013 - 06:40

Y su equivalente sin bases de datos

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.