Javascript Disabled Detected

You currently have javascript disabled. Several functions may not work. Please re-enable javascript to access full functionality.

Problema al agrandar este nuevo componente

Started by Desart , May 30 2013 05:46 AM

Please log in to reply

5 replies to this topic

#1 Desart

Advanced Member

Miembro Platino
715 posts

LocationEspaña

Posted 30 May 2013 - 05:46 AM

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

#2 Desart

Advanced Member

Miembro Platino
715 posts

LocationEspaña

Posted 30 May 2013 - 12:23 PM

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;

#3 poliburro

Advanced Member

Administrador
4945 posts

LocationMéxico

Posted 30 May 2013 - 12:27 PM

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

#4 Desart

Advanced Member

Miembro Platino
715 posts

LocationEspaña

Posted 01 June 2013 - 06:38 AM

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.

#5 Desart

Advanced Member

Miembro Platino
715 posts

LocationEspaña

Posted 01 June 2013 - 06:40 AM

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.