Ir al contenido


Foto

Problema al agrandar este nuevo componente


  • Por favor identifícate para responder
5 respuestas en este tema

#1 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 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
  1. { ****************************************************************** }
  2. {                                                                    }
  3. {  VCL component TDBNewEditJL                                        }
  4. {                                                                    }
  5. {  Code generated by Component Create for Delphi                    }
  6. {                                                                    }
  7. {  Generated from untitled component definition                    }
  8. {  on 25 May 2013 at 11:52                                          }
  9. {                                                                    }
  10. {  Copyright © 201 by J.L.G.T.3                                    }
  11. {                                                                    }
  12. { ****************************************************************** }
  13.  
  14. unit DBneweditjl;
  15.  
  16. interface
  17.  
  18. uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
  19.     Forms, Graphics, Stdctrls, Dialogs, Windows, DbTables, DB, DBCtrls;
  20.  
  21. type
  22.   TBorderStyle = (bsNone, bsSingle, bsRound);
  23.  
  24.   TDBNewEditJL = class(TEdit)
  25.     private
  26.         FColorFocused : TColor;
  27.         FOnlyNumbersDouble : Boolean;
  28.         FOnlyDate  : Boolean;
  29.         FFillToEnterDate: Boolean;
  30.         FTextDefault : String;
  31.         FAlignment: TAlignment;
  32.         FBorderStyle: TBorderStyle;
  33.         FBorderColor: TColor;
  34.         FBorderRadio: Integer;
  35.         FDataLink : TFieldDataLink;
  36.         FBorderThick: Integer;
  37.         FIncr:Double;
  38.         FEnterTab:Boolean;
  39.         FMaxLenghTab:Boolean;
  40.         procedure SetEnterTab(Value: boolean);
  41.         function GetDataSource : TDataSource;
  42.         function GetDataField : String;
  43.         procedure SetDataField(Value : String);
  44.         procedure SetBorderThick(Value:Integer);
  45.         procedure SetIncr(Value: Double);
  46.         procedure SetMaxLenghTab(Value: boolean);
  47.         procedure SetDataSource(Value : TDataSource);
  48.         procedure ActiveChange(Sender : TObject);
  49.         procedure DataChange(Sender : TObject);
  50.         procedure EditingChange(Sender : TObject);
  51.         procedure UpdateData(Sender : TObject);
  52.         procedure SetBorderColor(Color: TColor);
  53.         procedure SetBorderRadio(Radio: integer);
  54.         procedure SetBorderStyle(Value: TBorderStyle);
  55.         procedure SetRound(Value: boolean);
  56.         procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  57.         procedure WMSize(var Message: TWMSize); message WM_SIZE;
  58.         procedure SetOnlyDate (Value : Boolean);
  59.         procedure SetFillToEnterDate(Value : Boolean);
  60.         procedure SetAlignment(Value: TAlignment);
  61.         procedure AutoInitialize;
  62.         procedure AutoDestroy;
  63.         procedure SetColorFocused(Value : TColor);
  64.         procedure SetOnlyNumbersDouble(Value : Boolean);
  65.         procedure SetTextDefault(Value : String);
  66.         procedure FOnResized(Sender: TObject);
  67.         var VarCColor:Tcolor;
  68.     protected
  69.         procedure CreateWnd; override;
  70.         procedure Change; override;
  71.         procedure Click; override;
  72.         procedure KeyPress(var Key : Char); override;
  73.         procedure Loaded; override;
  74.         procedure CreateParams(var Params: TCreateParams); override;
  75.         procedure DoExit; override;
  76.         procedure DoEnter; override;
  77.         procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  78.     public
  79.         constructor Create(AOwner: TComponent); override;
  80.         destructor Destroy; override;
  81.     published
  82.         property OnChange;
  83.         property OnClick;
  84.         property OnDblClick;
  85.         property OnDragDrop;
  86.         property OnEnter;
  87.         property OnExit;
  88.         property OnKeyDown;
  89.         property OnKeyPress;
  90.         property OnKeyUp;
  91.         property OnMouseDown;
  92.         property OnMouseMove;
  93.         property OnMouseUp;
  94.         property OnResize;
  95.         property ColorFocused : TColor read FColorFocused write SetColorFocused default clSkyBlue;
  96.         property OnlyNumbersDouble : Boolean read FOnlyNumbersDouble write SetOnlyNumbersDouble default False;
  97.         property TextDefault : String read FTextDefault write SetTextDefault;
  98.         property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  99.         property FillToEnterDate: Boolean read FFillToEnterDate write SetFillToEnterDate default False;
  100.         property OnlyDate: Boolean read FOnlyDate write SetOnlyDate default False;
  101.         property BorderColor: TColor  read FBorderColor write SetBorderColor default clNavy;
  102.         property BorderRadio: Integer read FBorderRadio write SetBorderRadio default 5;
  103.         property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; //default bsRound;
  104.         property DataField : String read GetDataField write SetDataField;
  105.         property DataSource : TDataSource read GetDataSource write SetDataSource;
  106.         property Incr: Double read FIncr write SetIncr;
  107.         property MaxLenghTab: Boolean read FMaxLenghTab write SetMaxLenghTab default False;
  108.         property BorderThick: Integer read FBorderThick write SetBorderThick default 1;
  109.         property EnterTab: Boolean read FEnterTab write SetEnterTab default False;
  110. end;
  111.  
  112. procedure Register;
  113.  
  114. implementation
  115.  
  116. procedure Register;
  117. begin
  118.     RegisterComponents('Data Controls', [TDBNewEditJL]);
  119. end;
  120.  
  121. procedure TDBNewEditJL.AutoInitialize;
  122. begin
  123.     FColorFocused := clSkyBlue;
  124.     FOnlyNumbersDouble := False;
  125.     FAlignment:=taLeftJustify;
  126.     FBorderColor:= clNavy;
  127.     FBorderRadio:= 5;
  128.     FBorderStyle:= bsRound;
  129.     FOnlyDate  :=false;
  130.     FFillToEnterDate:=True;
  131.     FTextDefault :='';
  132.     FDataLink := TFieldDataLink.Create;
  133.     with FDataLink do
  134.     begin
  135.           { Assign handlers }
  136.           OnDataChange := DataChange;
  137.           OnUpdateData := UpdateData;
  138.           OnEditingChange := EditingChange;
  139.           OnActiveChange := ActiveChange;
  140.     end;
  141.     FIncr:=0.01;
  142.     FMaxLenghTab:=True;
  143.     FBorderThick:=1;
  144.     FEnterTab:=False;
  145.     OnResize := FOnResized;
  146. end; { of AutoInitialize }
  147.  
  148. procedure TDBNewEditJL.AutoDestroy;
  149. begin
  150.     FDataLink.Free;
  151. end; { of AutoDestroy }
  152.  
  153. function TDBNewEditJL.GetDataField : String;
  154. begin
  155.     Result := FDataLink.FieldName;
  156. end;
  157.  
  158. procedure TDBNewEditJL.SetDataField(Value : String);
  159. begin
  160.     FDataLink.FieldName := Value;
  161. end;
  162.  
  163. function TDBNewEditJL.GetDataSource : TDataSource;
  164. begin
  165.     Result := FDataLink.DataSource;
  166. end;
  167.  
  168. procedure TDBNewEditJL.SetDataSource(Value : TDataSource);
  169. begin
  170.     FDataLink.DataSource := Value;
  171. end;
  172.  
  173.  
  174. procedure TDBNewEditJL.SetEnterTab(Value: boolean);
  175. begin
  176.   if FEnterTab<>value then FEnterTab:=Value;
  177. end;
  178.  
  179. procedure TDBNewEditJL.ActiveChange(Sender : TObject);
  180. const IntFieldTypes = [ftSmallInt, ftInteger, ftWord];
  181. begin
  182.     if DataField = '' then  Exit;
  183.     if FDataLink <> nil then
  184.         if FDataLink.Dataset <> nil then
  185.           if FDataLink.Dataset.Active then    Text:=FDataLink.Field.AsString;
  186.   //  raise EDatabaseError.Create('Wrong field type');
  187. end;
  188.  
  189. procedure TDBNewEditJL.DataChange(Sender : TObject);
  190. begin
  191.     if FDataLink.Field = nil then
  192.         begin
  193.  
  194.         end
  195.     else
  196.         begin
  197.           Text:=FDataLink.Field.AsString;
  198.         { Update component using properties of FDataLink.Field }
  199.         end
  200. end;
  201.  
  202. procedure TDBNewEditJL.UpdateData(Sender : TObject);
  203. begin
  204.     { Respond to OnUpdateData events of FDataLink }
  205.       Text:=FDataLink.Field.AsString;
  206. end;
  207.  
  208. procedure TDBNewEditJL.SetAlignment(Value: TAlignment);
  209. begin
  210.   if FAlignment <> Value then
  211.   begin
  212.     FAlignment := Value;
  213.     RecreateWnd;
  214.   end;
  215.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  216. end;
  217.  
  218. procedure TDBNewEditJL.SetColorFocused(Value : TColor);
  219. begin
  220.     FColorFocused := Value;
  221.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  222. end;
  223.  
  224. procedure TDBNewEditJL.SetFillToEnterDate(Value: Boolean);
  225. begin
  226.     if FFillToEnterDate<>value then FFillToEnterDate:=Value;
  227.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  228. end;
  229.  
  230. procedure TDBNewEditJL.SetIncr(Value: Double);
  231. begin
  232.     if FIncr<>Value then FIncr:=Value;
  233.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  234. end;
  235.  
  236. procedure TDBNewEditJL.SetMaxLenghTab(Value: boolean);
  237. begin
  238.   if FMaxLenghTab<>Value then FMaxLenghTab:=value;
  239.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  240. end;
  241.  
  242. procedure TDBNewEditJL.SetOnlyDate(Value: Boolean);
  243. begin
  244.   if FOnlyDate<>value then
  245.   begin
  246.     if (FOnlyNumbersDouble) and (Value=true) then FOnlyNumbersDouble:=False;
  247.     FOnlyDate:=Value;
  248.   end;
  249.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  250. end;
  251.  
  252. procedure TDBNewEditJL.SetOnlyNumbersDouble(Value: Boolean);
  253. begin
  254.   if FOnlyNumbersDouble<>value then
  255.   begin
  256.     if (FOnlyDate) and (Value=true) then FOnlyDate:=False;
  257.     if Value=true then Alignment:=taRightJustify else Alignment:=taLeftJustify;
  258.     FOnlyNumbersDouble:=Value;
  259.   end;
  260.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  261. end;
  262.  
  263. procedure TDBNewEditJL.EditingChange(Sender : TObject);
  264. begin
  265.     { Respond to OnEditingChange events of FDataLink }
  266.     { The data source has gone from editing to non-editing,
  267.       or the reverse; update the component's properties
  268.       based on the value of FDataLink.Editing. }
  269.     { ReadOnly := not FDataLink.Editing; }
  270.     { . . . if the component has a ReadOnly property, or . . . }
  271.     { Enabled := not FDataLink.Editing; }
  272.     if FDataLink.DataSet.State in [dsEdit, dsInsert]  then
  273.     begin
  274.         if OnlyDate then FDataLink.Field.Value:=StrToDate(Text)
  275.         else if OnlyNumbersDouble then FDataLink.Field.Value:=StrToFloat(text)
  276.           else FDataLink.Field.Value:=Text;
  277.     end;
  278. end;
  279.  
  280. procedure TDBNewEditJL.FOnResized(Sender: TObject);
  281. begin
  282.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  283. end;
  284.  
  285. procedure TDBNewEditJL.SetTextDefault(Value : String);
  286. begin
  287.     if FTextDefault<>Value then FTextDefault := Value;
  288.       RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  289. end;
  290.  
  291. procedure TDBNewEditJL.Change;
  292. begin
  293.     inherited Change;
  294.     if FMaxLenghTab then
  295.     begin
  296.       if (Length(Text)>=MaxLength) and (MaxLength<>0) and (Self.Focused) then keybd_event(VK_TAB ,0,0,0); //Pulsa el tab por código
  297.     end;
  298. end;
  299.  
  300. procedure TDBNewEditJL.Click;
  301. begin
  302.     inherited Click;
  303.       RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  304. end;
  305.  
  306. procedure TDBNewEditJL.KeyDown(var Key: Word; Shift: TShiftState);
  307. var Numer:Double;
  308. begin
  309.   if FOnlyDate then
  310.   begin
  311.     if (Key=VK_UP) then text:=DateToStr(StrToDate(Self.Text)+1);  //Añadimos  díaa
  312.     if (Key=VK_DOWN) then Text:=DateToStr(StrToDate(Self.Text)+1);//Disminuimos  días
  313.     Key := 0;
  314.   end;
  315.   if FOnlyNumbersDouble then
  316.   begin
  317.     Numer:=StrToFloat(Text);
  318.     if (Key=VK_UP) then Numer:=numer+FIncr;
  319.     if (Key=VK_DOWN) then Numer:=Numer-FIncr;
  320.     if Numer>=0 then Text:=FloatToStr(Numer)
  321.                 else text:='-'+FloatToStr(Numer);
  322.     Key := 0;
  323.   end;
  324.   inherited KeyDown(Key, Shift);
  325. end;
  326.  
  327. procedure TDBNewEditJL.KeyPress(var Key : Char);
  328. const TabKey = Char(VK_TAB);
  329.       EnterKey = Char(VK_RETURN);
  330. begin
  331.   if FOnlyNumbersDouble then
  332.   begin
  333.     if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
  334.     begin
  335.         ShowMessage('Tecla no valida: ' + Key);
  336.         Key := #0;
  337.     end else if ((Key = DecimalSeparator) or (Key = '-') or (Key=',')) and (Pos(Key, Self.Text) > 0) then
  338.     begin
  339.         ShowMessage('Tecla no valida: (por repetida) ' + Key);
  340.         Key := #0;
  341.     end else if (Key = '-') and (Self.SelStart <> 0) then
  342.     begin
  343.         ShowMessage('Sólo se permite numeros: ' + Key);
  344.         Key := #0;
  345.     end;
  346.   end;
  347.   If Key = #13 Then
  348.   Begin
  349.       if FEnterTab then
  350.       begin
  351.         keybd_event(VK_TAB ,0,0,0); //Pulsa el Tab por código
  352.         Key := #0
  353.       end;
  354.   end;
  355.   inherited KeyPress(Key);
  356. end;
  357.  
  358. constructor TDBNewEditJL.Create(AOwner: TComponent);
  359. begin
  360.     inherited Create(AOwner);
  361.     AutoInitialize;
  362. end;
  363.  
  364. procedure TDBNewEditJL.CreateParams(var Params: TCreateParams);
  365. const
  366.   Alignments : array[TAlignment] of LongWord= (ES_Left,ES_Right, ES_Center);
  367. begin
  368.   inherited CreateParams(Params);
  369.   Params.Style := Params.Style or Alignments[FAlignment];
  370. end;
  371.  
  372. destructor TDBNewEditJL.Destroy;
  373. begin
  374.     AutoDestroy;
  375.     inherited Destroy;
  376. end;
  377.  
  378. procedure TDBNewEditJL.Loaded;
  379. begin
  380.     inherited Loaded;
  381. end;
  382.  
  383. procedure TDBNewEditJL.DoEnter;
  384. begin
  385.   inherited;
  386.   VarCColor:=Self.Color;
  387.   SElf.Color:=fcolorFocused;
  388.   if (FOnlyDate) and (FillToEnterDate) then Self.Text:=DateToStr(Now);
  389. end;
  390.  
  391. procedure TDBNewEditJL.DoExit;
  392. begin
  393.   self.Color:=VarCColor;
  394.   if (self.text='') and (FOnlyNumbersDouble=False) and (FOnlyDate=false) then self.text:=ftextDefault;
  395.   if (FOnlyNumbersDouble) and (Self.Text='') then Self.Text:='0';
  396.   if (FOnlyDate) and (Self.Text='') then Self.Text:=DateToStr(Now);
  397.   inherited;
  398. end;
  399.  
  400. //todo esto es cogido del compañero Escafandra de su componente RoundEdit
  401.  
  402. procedure TDBNewEditJL.CreateWnd;
  403. begin
  404.   inherited CreateWnd;
  405.   SetRound(FBorderStyle = bsRound);
  406. end;
  407.  
  408.  
  409. procedure TDBNewEditJL.SetRound(Value: boolean);
  410. var
  411.   Rgn: HRGN;
  412. begin
  413.   Rgn:= 0;
  414.   if Value then
  415.     Rgn := CreateRoundRectRgn(0, 0, Width+1, Height+1, FBorderRadio-2, FBorderRadio-2) ;
  416.   SetWindowRgn(Handle, Rgn, true);
  417.   DeleteObject(Rgn);
  418. end;
  419.  
  420. procedure TDBNewEditJL.SetBorderColor(Color: TColor);
  421. begin
  422.   FBorderColor:= Color;
  423.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  424.   Invalidate;
  425. end;
  426.  
  427.  
  428. procedure TDBNewEditJL.SetBorderRadio(Radio: integer);
  429. begin
  430.   if Radio <= 10 then
  431.   begin
  432.     FBorderRadio:= Radio;
  433.     SetRound(true);
  434.     RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  435.   end;
  436. end;
  437.  
  438. procedure TDBNewEditJL.SetBorderStyle(Value: TBorderStyle);
  439. begin
  440.   if Value <> FBorderStyle then
  441.   begin
  442.     FBorderStyle:= Value;
  443.     SetRound(false);
  444.     inherited Ctl3D:= Ctl3D;
  445.     case Value of
  446.       bsNone:  inherited BorderStyle := Forms.TBorderStyle(bsNone);
  447.       bsSingle: inherited BorderStyle := Forms.TBorderStyle(bsSingle);
  448.       bsRound:
  449.       begin
  450.         inherited BorderStyle := Forms.TBorderStyle(bsSingle);
  451.         inherited Ctl3D:= true;
  452.         SetRound(true);
  453.       end;
  454.     end;
  455.     RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  456.   end;
  457. end;
  458.  
  459.  
  460. procedure TDBNewEditJL.SetBorderThick(Value: Integer);
  461. begin
  462.     if FBorderThick<>value then FBorderThick:=Value;      //añadido por mi
  463. end;
  464.  
  465. procedure TDBNewEditJL.WMNCPaint(var Message: TMessage);
  466. var
  467.   Brush: TBrush;
  468.   Pen: TPen;
  469.   DC: HDC;
  470.   Clip: integer;
  471. begin
  472.   if (BorderStyle <> bsRound) or not inherited Ctl3D then
  473.   begin
  474.     inherited;
  475.     exit;
  476.   end;
  477.  
  478.   DC:= GetWindowDC(Handle);
  479.   Brush:= TBrush.Create;
  480.   Pen:= TPen.Create;
  481.   Pen.Color:= BorderColor;
  482.   Pen.Width:=FBorderThick;  //añadido por mi
  483.   Brush.Color:= Color;
  484.  
  485.   ExcludeClipRect(DC, 4, 4, Width-4, Height-4);
  486.   Windows.SelectObject(DC, Brush.Handle);
  487.   Windows.SelectObject(DC, Pen.Handle);
  488.  
  489.   Windows.Rectangle(DC, 0, 0, Width, Height);
  490.   Brush.Style:= bsClear;
  491.   Windows.RoundRect(DC, 0, 0, Width, Height,  FBorderRadio, FBorderRadio);
  492.  
  493.   Windows.ReleaseDC(Handle, DC);
  494.   Brush.Destroy;
  495.   Pen.Destroy;
  496. end;
  497.  
  498. procedure TDBNewEditJL.WMSize(var Message: TWMSize);
  499. var r : TRect;
  500. begin
  501.   inherited;
  502.   r := ClientRect;
  503.   InvalidateRect(handle,@r,false);
  504.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  505. end;
  506.  
  507. end.



LA imagen

Imagen Enviada

he marcado en rojo para que veais el fallo.

y por el último el archivo

  • 0

#2 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 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
  1. procedure TDBNewEditJL.WMSize(var Message: TWMSize);
  2. var r : TRect;
  3. begin
  4.   inherited;
  5.   r := ClientRect;
  6.   SetRound(True);
  7.   InvalidateRect(handle,@r,false);
  8.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  9. end;


  • 0

#3 poliburro

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
  • 0

#4 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 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
  1. { ****************************************************************** }
  2. {                                                                    }
  3. {  VCL component TDBNewEditJL                                        }
  4. {                                                                    }
  5. {  Code generated by Component Create for Delphi                    }
  6. {                                                                    }
  7. {  Generated from untitled component definition                    }
  8. {  on 25 May 2013 at 11:52                                          }
  9. {                                                                    }
  10. {  Copyright © 201 by J.L.G.T.3                                    }
  11. {                                                                    }
  12. { ****************************************************************** }
  13.  
  14. unit DBneweditjl;
  15.  
  16. interface
  17.  
  18. uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
  19.     Forms, Graphics, Stdctrls, Dialogs, Windows, DbTables, DB, DBCtrls;
  20.  
  21. type
  22.   TBorderStyle = (bsNone, bsSingle, bsRound);
  23.  
  24.   TDBNewEditJL = class(TDBEdit)
  25.     private
  26.         FColorFocused : TColor;
  27.         FOnlyNumbersDouble : Boolean;
  28.         FOnlyDate  : Boolean;
  29.         FFillToEnterDate: Boolean;
  30.         FTextDefault : String;
  31.         FAlignment: TAlignment;
  32.         FBorderStyle: TBorderStyle;
  33.         FBorderColor: TColor;
  34.         FBorderRadio: Integer;
  35.         FDataLink : TFieldDataLink;
  36.         FBorderThick: Integer;
  37.         FIncrouble;
  38.         FEnterTab:Boolean;
  39.         FMaxLenghTab:Boolean;
  40.         FMatchHintAndDefault: Boolean;
  41.         procedure SetMatchHintAndDefault(Value:Boolean);
  42.         procedure SetEnterTab(Value: boolean);
  43.         procedure SetBorderThick(Value:Integer);
  44.         procedure SetIncr(Value: Double);
  45.         procedure SetMaxLenghTab(Value: boolean);
  46.         procedure SetBorderColor(Color: TColor);
  47.         procedure SetBorderRadio(Radio: integer);
  48.         procedure SetBorderStyle(Value: TBorderStyle);
  49.         procedure SetRound(Value: boolean);
  50.         procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  51.         procedure WMSize(var Message: TWMSize); message WM_SIZE;
  52.         procedure SetOnlyDate (Value : Boolean);
  53.         procedure SetFillToEnterDate(Value : Boolean);
  54.         procedure SetAlignment(Value: TAlignment);
  55.         procedure AutoInitialize;
  56.         procedure AutoDestroy;
  57.         procedure SetColorFocused(Value : TColor);
  58.         procedure SetOnlyNumbersDouble(Value : Boolean);
  59.         procedure SetTextDefault(Value : String);
  60.         procedure FOnResized(Sender: TObject);
  61.         var VarCColor:Tcolor;
  62.     protected
  63.         procedure CreateWnd; override;
  64.         procedure Change; override;
  65.         procedure Click; override;
  66.         procedure KeyPress(var Key : Char); override;
  67.         procedure Loaded; override;
  68.         procedure CreateParams(var Params: TCreateParams); override;
  69.         procedure DoExit; override;
  70.         procedure DoEnter; override;
  71.         procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  72.     public
  73.         constructor Create(AOwner: TComponent); override;
  74.         destructor Destroy; override;
  75.     published
  76.         property Text;
  77.         property TextHint;
  78.         property OnChange;
  79.         property OnClick;
  80.         property OnDblClick;
  81.         property OnDragDrop;
  82.         property OnEnter;
  83.         property OnExit;
  84.         property OnKeyDown;
  85.         property OnKeyPress;
  86.         property OnKeyUp;
  87.         property OnMouseDown;
  88.         property OnMouseMove;
  89.         property OnMouseUp;
  90.         property OnResize;
  91.         property ColorFocused : TColor read FColorFocused write SetColorFocused default clSkyBlue;
  92.         property OnlyNumbersDouble : Boolean read FOnlyNumbersDouble write SetOnlyNumbersDouble default False;
  93.         property TextDefault : String read FTextDefault write SetTextDefault;
  94.         property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  95.         property FillToEnterDate: Boolean read FFillToEnterDate write SetFillToEnterDate default False;
  96.         property OnlyDate: Boolean read FOnlyDate write SetOnlyDate default False;
  97.         property BorderColor: TColor  read FBorderColor write SetBorderColor default clNavy;
  98.         property BorderRadio: Integer read FBorderRadio write SetBorderRadio default 5;
  99.         property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; //default bsRound;
  100.         property Incr: Double read FIncr write SetIncr;
  101.         property MaxLenghTab: Boolean read FMaxLenghTab write SetMaxLenghTab default False;
  102.         property BorderThick: Integer read FBorderThick write SetBorderThick default 1;
  103.         property EnterTab: Boolean read FEnterTab write SetEnterTab default False;
  104.         property MatchHintAndDefault: Boolean read FMatchHintAndDefault write setMatchHintAndDefault default True;
  105. end;
  106.  
  107. procedure Register;
  108.  
  109. implementation
  110.  
  111. procedure Register;
  112. begin
  113.     RegisterComponents('Data Controls', [TDBNewEditJL]);
  114. end;
  115.  
  116. procedure TDBNewEditJL.AutoInitialize;
  117. begin
  118.     FColorFocused := clSkyBlue;
  119.     FOnlyNumbersDouble := False;
  120.     FAlignment:=taLeftJustify;
  121.     FBorderColor:= clNavy;
  122.     FBorderRadio:= 5;
  123.     FBorderStyle:= bsRound;
  124.     FOnlyDate  :=false;
  125.     FFillToEnterDate:=True;
  126.     FTextDefault :='';
  127.     FMatchHintAndDefault:=True;
  128.     FIncr:=0.01;
  129.     FMaxLenghTab:=True;
  130.     FBorderThick:=1;
  131.     FEnterTab:=False;
  132.     OnResize := FOnResized;
  133. end; { of AutoInitialize }
  134.  
  135. procedure TDBNewEditJL.AutoDestroy;
  136. begin
  137.   {...}
  138. end; { of AutoDestroy }
  139.  
  140.  
  141. procedure TDBNewEditJL.SetEnterTab(Value: boolean);
  142. begin
  143.   if FEnterTab<>value then FEnterTab:=Value;
  144. end;
  145.  
  146. procedure TDBNewEditJL.SetAlignment(Value: TAlignment);
  147. begin
  148.   if FAlignment <> Value then
  149.   begin
  150.     FAlignment := Value;
  151.     RecreateWnd;
  152.   end;
  153.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  154. end;
  155.  
  156. procedure TDBNewEditJL.SetColorFocused(Value : TColor);
  157. begin
  158.     FColorFocused := Value;
  159.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  160. end;
  161.  
  162. procedure TDBNewEditJL.SetFillToEnterDate(Value: Boolean);
  163. begin
  164.     if FFillToEnterDate<>value then FFillToEnterDate:=Value;
  165.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  166. end;
  167.  
  168. procedure TDBNewEditJL.SetIncr(Value: Double);
  169. begin
  170.     if FIncr<>Value then FIncr:=Value;
  171.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  172. end;
  173.  
  174. procedure TDBNewEditJL.SetMatchHintAndDefault(Value: Boolean);
  175. begin
  176. if fMatchHintAndDefault<>value then FMatchHintAndDefault:=Value;
  177. end;
  178.  
  179. procedure TDBNewEditJL.SetMaxLenghTab(Value: boolean);
  180. begin
  181.   if FMaxLenghTab<>Value then FMaxLenghTab:=value;
  182.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  183. end;
  184.  
  185. procedure TDBNewEditJL.SetOnlyDate(Value: Boolean);
  186. begin
  187.   if FOnlyDate<>value then
  188.   begin
  189.     if (FOnlyNumbersDouble) and (Value=true) then FOnlyNumbersDouble:=False;
  190.     FOnlyDate:=Value;
  191.   end;
  192.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  193. end;
  194.  
  195. procedure TDBNewEditJL.SetOnlyNumbersDouble(Value: Boolean);
  196. begin
  197.   if FOnlyNumbersDouble<>value then
  198.   begin
  199.     if (FOnlyDate) and (Value=true) then FOnlyDate:=False;
  200.     if Value=true then Alignment:=taRightJustify else Alignment:=taLeftJustify;
  201.     FOnlyNumbersDouble:=Value;
  202.   end;
  203.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  204. end;
  205.  
  206.  
  207. procedure TDBNewEditJL.FOnResized(Sender: TObject);
  208. begin
  209.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  210. end;
  211.  
  212. procedure TDBNewEditJL.SetTextDefault(Value : String);
  213. begin
  214.     if FTextDefault<>Value then FTextDefault := Value;
  215.     if fMatchHintAndDefault then Self.TextHint:=Value;
  216.       RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  217. end;
  218.  
  219. procedure TDBNewEditJL.Change;
  220. begin
  221.     inherited Change;
  222.     if FMaxLenghTab then
  223.     begin
  224.       if (Length(Text)>=MaxLength) and (MaxLength<>0) and (Self.Focused) then keybd_event(VK_TAB ,0,0,0); //Pulsa el tab por código
  225.     end;
  226. end;
  227.  
  228. procedure TDBNewEditJL.Click;
  229. begin
  230.     inherited Click;
  231.       RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  232. end;
  233.  
  234. procedure TDBNewEditJL.KeyDown(var Key: Word; Shift: TShiftState);
  235. var Numerouble;
  236. begin
  237.   if FOnlyDate then
  238.   begin
  239.     if (Key=VK_UP) then text:=DateToStr(StrToDate(Self.Text)+1);  //Añadimos  díaa
  240.     if (Key=VK_DOWN) then Text:=DateToStr(StrToDate(Self.Text)+1);//Disminuimos  días
  241.     Key := 0;
  242.   end;
  243.   if FOnlyNumbersDouble then
  244.   begin
  245.     Numer:=StrToFloat(Text);
  246.     if (Key=VK_UP) then Numer:=numer+FIncr;
  247.     if (Key=VK_DOWN) then Numer:=Numer-FIncr;
  248.     if Numer>=0 then Text:=FloatToStr(Numer)
  249.                 else text:='-'+FloatToStr(Numer);
  250.     Key := 0;
  251.   end;
  252.   inherited KeyDown(Key, Shift);
  253. end;
  254.  
  255. procedure TDBNewEditJL.KeyPress(var Key : Char);
  256. const TabKey = Char(VK_TAB);
  257.       EnterKey = Char(VK_RETURN);
  258. begin
  259.   if FOnlyNumbersDouble then
  260.   begin
  261.     if Key='.' then Key:=',';  //Para los Decimales
  262.     if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
  263.     begin
  264.         ShowMessage('Tecla no valida: ' + Key);
  265.         Key := #0;
  266.     end else if ((Key = DecimalSeparator) or (Key = '-') or (Key=',') or (Key = #8 )) and (Pos(Key, Self.Text) > 0) then
  267.     begin
  268.         //#8= backSpace, #13= Enter, #25= LeftArrow, #274= RightArrow
  269.         ShowMessage('Tecla no valida: (por repetida) ' + Key);
  270.         Key := #0;
  271.     end else if (Key = '-') and (Self.SelStart <> 0) then
  272.     begin
  273.         ShowMessage('Sólo se permite numeros: ' + Key);
  274.         Key := #0;
  275.     end;
  276.   end;
  277.   If Key = #13 Then
  278.   Begin
  279.       if FEnterTab then
  280.       begin
  281.         keybd_event(VK_TAB ,0,0,0); //Pulsa el Tab por código
  282.         Key := #0
  283.       end;
  284.   end;
  285.   inherited KeyPress(Key);
  286. end;
  287.  
  288. constructor TDBNewEditJL.Create(AOwner: TComponent);
  289. begin
  290.     inherited Create(AOwner);
  291.     AutoInitialize;
  292. end;
  293.  
  294. procedure TDBNewEditJL.CreateParams(var Params: TCreateParams);
  295. const
  296.   Alignments : array[TAlignment] of LongWord= (ES_Left,ES_Right, ES_Center);
  297. begin
  298.   inherited CreateParams(Params);
  299.   Params.Style := Params.Style or Alignments[FAlignment];
  300. end;
  301.  
  302. destructor TDBNewEditJL.Destroy;
  303. begin
  304.     AutoDestroy;
  305.     inherited Destroy;
  306. end;
  307.  
  308. procedure TDBNewEditJL.Loaded;
  309. begin
  310.     inherited Loaded;
  311. end;
  312.  
  313. procedure TDBNewEditJL.DoEnter;
  314. begin
  315.   inherited;
  316.   VarCColor:=Self.Color;
  317.   SElf.Color:=fcolorFocused;
  318.   if (FOnlyDate) and (FillToEnterDate) then Self.Text:=DateToStr(Now);
  319. end;
  320.  
  321. procedure TDBNewEditJL.DoExit;
  322. begin
  323.   self.Color:=VarCColor;
  324.   if (self.text='') and (FOnlyNumbersDouble=False) and (FOnlyDate=false) then self.text:=ftextDefault;
  325.   if (FOnlyNumbersDouble) and (Self.Text='') then Self.Text:='0';
  326.   if (FOnlyDate) and (Self.Text='') then Self.Text:=DateToStr(Now);
  327.   inherited;
  328. end;
  329.  
  330. //todo esto es cogido del compañero Escafandra de su componente RoundEdit
  331.  
  332. procedure TDBNewEditJL.CreateWnd;
  333. begin
  334.   inherited CreateWnd;
  335.   SetRound(FBorderStyle = bsRound);
  336. end;
  337.  
  338.  
  339. procedure TDBNewEditJL.SetRound(Value: boolean);
  340. var
  341.   Rgn: HRGN;
  342. begin
  343.   Rgn:= 0;
  344.   if Value then
  345.     Rgn := CreateRoundRectRgn(0, 0, Width+1, Height+1, FBorderRadio-2, FBorderRadio-2) ;
  346.   SetWindowRgn(Handle, Rgn, true);
  347.   DeleteObject(Rgn);
  348. end;
  349.  
  350. procedure TDBNewEditJL.SetBorderColor(Color: TColor);
  351. begin
  352.   FBorderColor:= Color;
  353.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  354.   Invalidate;
  355. end;
  356.  
  357.  
  358. procedure TDBNewEditJL.SetBorderRadio(Radio: integer);
  359. begin
  360.   if Radio <= 10 then
  361.   begin
  362.     FBorderRadio:= Radio;
  363.     SetRound(true);
  364.     RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  365.   end;
  366. end;
  367.  
  368. procedure TDBNewEditJL.SetBorderStyle(Value: TBorderStyle);
  369. begin
  370.   if Value <> FBorderStyle then
  371.   begin
  372.     FBorderStyle:= Value;
  373.     SetRound(false);
  374.     inherited Ctl3D:= Ctl3D;
  375.     case Value of
  376.       bsNone:  inherited BorderStyle := Forms.TBorderStyle(bsNone);
  377.       bsSingle: inherited BorderStyle := Forms.TBorderStyle(bsSingle);
  378.       bsRound:
  379.       begin
  380.         inherited BorderStyle := Forms.TBorderStyle(bsSingle);
  381.         inherited Ctl3D:= true;
  382.         SetRound(true);
  383.       end;
  384.     end;
  385.     RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  386.   end;
  387. end;
  388.  
  389. procedure TDBNewEditJL.SetBorderThick(Value: Integer);
  390. begin
  391.     if FBorderThick<>value then FBorderThick:=Value;      //añadido por mi
  392. end;
  393.  
  394. procedure TDBNewEditJL.WMNCPaint(var Message: TMessage);
  395. var
  396.   Brush: TBrush;
  397.   Pen: TPen;
  398.   DC: HDC;
  399.   Clip: integer;
  400. begin
  401.   if (BorderStyle <> bsRound) or not inherited Ctl3D then
  402.   begin
  403.     inherited;
  404.     exit;
  405.   end;
  406.  
  407.   DC:= GetWindowDC(Handle);
  408.   Brush:= TBrush.Create;
  409.   Pen:= TPen.Create;
  410.   Pen.Color:= BorderColor;
  411.   Pen.Width:=FBorderThick;  //añadido por mi
  412.   Brush.Color:= Color;
  413.  
  414.   ExcludeClipRect(DC, 4, 4, Width-4, Height-4);
  415.   Windows.SelectObject(DC, Brush.Handle);
  416.   Windows.SelectObject(DC, Pen.Handle);
  417.  
  418.   Windows.Rectangle(DC, 0, 0, Width, Height);
  419.   Brush.Style:= bsClear;
  420.   Windows.RoundRect(DC, 0, 0, Width, Height,  FBorderRadio, FBorderRadio);
  421.  
  422.   Windows.ReleaseDC(Handle, DC);
  423.   Brush.Destroy;
  424.   Pen.Destroy;
  425. end;
  426.  
  427. procedure TDBNewEditJL.WMSize(var Message: TWMSize);
  428. var r : TRect;
  429. begin
  430.   inherited;
  431.   r := ClientRect;
  432.   SetRound(True);
  433.   InvalidateRect(handle,@r,false);
  434.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  435. end;
  436.  
  437. end.


  • 0

#5 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 715 mensajes
  • LocationEspaña

Escrito 01 junio 2013 - 06:40

Y su equivalente sin bases de datos



delphi
  1. { ****************************************************************** }
  2. {                                                                    }
  3. {  VCL component TMyNewEditJL                                        }
  4. {                                                                    }
  5. {  Code generated by Component Create for Delphi                    }
  6. {                                                                    }
  7. {  Generated from untitled component definition                    }
  8. {  on 25 May 2013 at 11:52                                          }
  9. {                                                                    }
  10. {  Copyright © 201 by J.L.G.T.3                                    }
  11. {                                                                    }
  12. { ****************************************************************** }
  13.  
  14. unit Mneweditjl;
  15.  
  16. interface
  17.  
  18. uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
  19.     Forms, Graphics, Stdctrls, Dialogs, Windows;
  20.  
  21. type
  22.   TBorderStyle = (bsNone, bsSingle, bsRound);
  23.  
  24.   TMyNewEditJL = class(TEdit)
  25.     private
  26.         FColorFocused : TColor;
  27.         FOnlyNumbersDouble : Boolean;
  28.         FOnlyDate  : Boolean;
  29.         FFillToEnterDate: Boolean;
  30.         FTextDefault : String;
  31.         FAlignment: TAlignment;
  32.         FBorderStyle: TBorderStyle;
  33.         FBorderColor: TColor;
  34.         FBorderRadio: Integer;
  35.         FBorderThick: Integer;
  36.         FIncrouble;
  37.         FEnterTab:Boolean;
  38.         FMaxLenghTab:Boolean;
  39.         FMatchHintAndDefault: Boolean;
  40.         procedure SetMatchHintAndDefault(Value:Boolean);
  41.         procedure SetBorderThick(Value:Integer);
  42.         procedure SetIncr(Value: Double);
  43.         procedure SetEnterTab(Value: boolean);
  44.         procedure SetMaxLenghTab(Value: boolean);
  45.         procedure SetBorderColor(Color: TColor);
  46.         procedure SetBorderRadio(Radio: integer);
  47.         procedure SetBorderStyle(Value: TBorderStyle);
  48.         procedure SetRound(Value: boolean);
  49.         procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  50.         procedure SetOnlyDate (Value : Boolean);
  51.         procedure SetFillToEnterDate(Value : Boolean);
  52.         procedure SetAlignment(Value: TAlignment);
  53.         procedure AutoInitialize;
  54.         procedure AutoDestroy;
  55.         procedure SetColorFocused(Value : TColor);
  56.         procedure SetOnlyNumbersDouble(Value : Boolean);
  57.         procedure SetTextDefault(Value : String);
  58.         procedure WMSize(var Message: TWMSize); message WM_SIZE;
  59.         var VarCColor:Tcolor;
  60.     protected
  61.         procedure CreateWnd; override;
  62.         procedure Change; override;
  63.         procedure Click; override;
  64.         procedure KeyPress(var Key : Char); override;
  65.         procedure Loaded; override;
  66.         procedure CreateParams(var Params: TCreateParams); override;
  67.         procedure DoExit; override;
  68.         procedure DoEnter; override;
  69.         procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  70.     public
  71.         constructor Create(AOwner: TComponent); override;
  72.         destructor Destroy; override;
  73.     published
  74.         property Text;
  75.         property TextHint;
  76.         property OnChange;
  77.         property OnDblClick;
  78.         property OnDragDrop;
  79.         property OnEnter;
  80.         property OnExit;
  81.         property OnKeyDown;
  82.         property OnKeyPress;
  83.         property OnKeyUp;
  84.         property OnMouseDown;
  85.         property OnMouseMove;
  86.         property OnMouseUp;
  87.         property ColorFocused : TColor read FColorFocused write SetColorFocused default clSkyBlue;
  88.         property OnlyNumbersDouble : Boolean read FOnlyNumbersDouble write SetOnlyNumbersDouble default False;
  89.         property TextDefault : String read FTextDefault write SetTextDefault;
  90.         property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  91.         property FillToEnterDate: Boolean read FFillToEnterDate write SetFillToEnterDate default False;
  92.         property OnlyDate: Boolean read FOnlyDate write SetOnlyDate default False;
  93.         property BorderColor: TColor  read FBorderColor write SetBorderColor default clNavy;
  94.         property BorderRadio: Integer read FBorderRadio write SetBorderRadio default 5;
  95.         property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; //default bsRound;
  96.         property Incr: Double read FIncr write SetIncr;
  97.         property EnterTab: Boolean read FEnterTab write SetEnterTab default False;
  98.         property MaxLenghTab: Boolean read FMaxLenghTab write SetMaxLenghTab default False;
  99.         property BorderThick: Integer read FBorderThick write SetBorderThick default 1;
  100.         property MatchHintAndDefault: Boolean read FMatchHintAndDefault write setMatchHintAndDefault default True;
  101. end;
  102.  
  103. procedure Register;
  104.  
  105. implementation
  106.  
  107.  
  108. procedure Register;
  109. begin
  110.     RegisterComponents('Standard', [TMyNewEditJL]);
  111. end;
  112.  
  113. procedure TMyNewEditJL.AutoInitialize;
  114. begin
  115.     FColorFocused := clSkyBlue;
  116.     FOnlyNumbersDouble := False;
  117.     FAlignment:=taLeftJustify;
  118.     FBorderColor:= clNavy;
  119.     FBorderRadio:= 5;
  120.     FBorderStyle:= bsRound;
  121.     FOnlyDate  :=false;
  122.     FFillToEnterDate:=True;
  123.     FTextDefault :='';
  124.     FIncr:=0.01;
  125.     FMaxLenghTab:=True;
  126.     FEnterTab:=False;
  127.     FBorderThick:=1;
  128.     FMatchHintAndDefault:=True;
  129. end; { of AutoInitialize }
  130.  
  131. procedure TMyNewEditJL.AutoDestroy;
  132. begin
  133.   {}
  134. end; { of AutoDestroy }
  135.  
  136. procedure TMyNewEditJL.SetAlignment(Value: TAlignment);
  137. begin
  138.   if FAlignment <> Value then
  139.   begin
  140.     FAlignment := Value;
  141.     RecreateWnd;
  142.   end;
  143. end;
  144.  
  145. procedure TMyNewEditJL.SetColorFocused(Value : TColor);
  146. begin
  147.     FColorFocused := Value;
  148. end;
  149.  
  150. procedure TMyNewEditJL.SetEnterTab(Value: boolean);
  151. begin
  152.   if FEnterTab<>value then FEnterTab:=Value;
  153. end;
  154.  
  155. procedure TMyNewEditJL.SetFillToEnterDate(Value: Boolean);
  156. begin
  157.     if FFillToEnterDate<>value then FFillToEnterDate:=Value;
  158. end;
  159.  
  160. procedure TMyNewEditJL.SetIncr(Value: Double);
  161. begin
  162.   if FIncr<>Value then FIncr:=Value;
  163. end;
  164.  
  165. procedure TMyNewEditJL.SetMatchHintAndDefault(Value: Boolean);
  166. begin
  167.     if fMatchHintAndDefault<>value then FMatchHintAndDefault:=Value;
  168. end;
  169.  
  170. procedure TMyNewEditJL.SetMaxLenghTab(Value: boolean);
  171. begin
  172.   if FMaxLenghTab<>Value then FMaxLenghTab:=value;
  173. end;
  174.  
  175. procedure TMyNewEditJL.SetOnlyDate(Value: Boolean);
  176. begin
  177.   if FOnlyDate<>value then
  178.   begin
  179.     if (FOnlyNumbersDouble) and (Value=true) then FOnlyNumbersDouble:=False;
  180.     FOnlyDate:=Value;
  181.   end;
  182. end;
  183.  
  184. procedure TMyNewEditJL.SetOnlyNumbersDouble(Value : Boolean);
  185. begin
  186.   if FOnlyNumbersDouble<>value then
  187.   begin
  188.     if (FOnlyDate) and (Value=true) then FOnlyDate:=False;
  189.     if Value=true then Alignment:=taRightJustify else Alignment:=taLeftJustify;
  190.     FOnlyNumbersDouble:=Value;
  191.   end;
  192. end;
  193.  
  194. procedure TMyNewEditJL.SetTextDefault(Value : String);
  195. begin
  196.     FTextDefault := Value;
  197. end;
  198.  
  199. procedure TMyNewEditJL.Change;
  200. begin
  201.     inherited Change;
  202.     if FMaxLenghTab then
  203.     begin
  204.       if (Length(Text)>=MaxLength) and (MaxLength<>0) and (Self.Focused) then keybd_event(VK_TAB ,0,0,0); //Pulsa el tab por código
  205.     end;
  206. end;
  207.  
  208. procedure TMyNewEditJL.Click;
  209. begin
  210.     inherited Click;
  211. end;
  212.  
  213. procedure TMyNewEditJL.KeyDown(var Key: Word; Shift: TShiftState);
  214. var Numerouble;
  215. begin
  216.   if FOnlyDate then
  217.   begin
  218.     if (Key=VK_UP) then text:=DateToStr(StrToDate(Self.Text)+1);  //Añadimos  díaa
  219.     if (Key=VK_DOWN) then Text:=DateToStr(StrToDate(Self.Text)+1);//Disminuimos  días
  220.     Key := 0;
  221.   end;
  222.   if FOnlyNumbersDouble then
  223.   begin
  224.     Numer:=StrToFloat(Text);
  225.     if (Key=VK_UP) then Numer:=numer+FIncr;
  226.     if (Key=VK_DOWN) then Numer:=Numer-FIncr;
  227.     if Numer>=0 then Text:=FloatToStr(Numer)
  228.                 else text:='-'+FloatToStr(Numer);
  229.     Key := 0;
  230.   end;
  231.   inherited KeyDown(Key, Shift);
  232. end;
  233.  
  234. procedure TMyNewEditJL.KeyPress(var Key : Char);
  235. const TabKey = Char(VK_TAB);
  236.       EnterKey = Char(VK_RETURN);
  237. begin
  238.   if FOnlyNumbersDouble then
  239.   begin
  240.     if Key='.' then Key:=',';  //Para los Decimales
  241.     if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
  242.     begin
  243.         ShowMessage('Tecla no valida: ' + Key);
  244.         Key := #0;
  245.     end else if ((Key = DecimalSeparator) or (Key = '-') or (Key=',') or (Key = #8 )) and (Pos(Key, Self.Text) > 0) then
  246.     begin
  247.         ShowMessage('Tecla no valida: (por repetida) ' + Key);
  248.         Key := #0;
  249.     end else if (Key = '-') and (Self.SelStart <> 0) then
  250.     begin
  251.         ShowMessage('Sólo se permite numeros: ' + Key);
  252.         Key := #0;
  253.     end;
  254.   end;
  255.   If Key = #13 Then
  256.   Begin
  257.       if FEnterTab then
  258.       begin
  259.         keybd_event(VK_TAB ,0,0,0); //Pulsa el Tab por código
  260.         Key := #0
  261.       end;
  262.   end;
  263.   inherited KeyPress(Key);
  264. end;
  265.  
  266. constructor TMyNewEditJL.Create(AOwner: TComponent);
  267. begin
  268.     inherited Create(AOwner);
  269.     AutoInitialize;
  270. end;
  271.  
  272. procedure TMyNewEditJL.CreateParams(var Params: TCreateParams);
  273. const
  274.   Alignments : array[TAlignment] of LongWord= (ES_Left,ES_Right, ES_Center);
  275. begin
  276.   inherited CreateParams(Params);
  277.   Params.Style := Params.Style or Alignments[FAlignment];
  278. end;
  279.  
  280. destructor TMyNewEditJL.Destroy;
  281. begin
  282.     AutoDestroy;
  283.     inherited Destroy;
  284. end;
  285.  
  286. procedure TMyNewEditJL.Loaded;
  287. begin
  288.     inherited Loaded;
  289. end;
  290.  
  291. procedure TMyNewEditJL.DoEnter;
  292. begin
  293.   inherited;
  294.   VarCColor:=Self.Color;
  295.   SElf.Color:=fcolorFocused;
  296.   if (FOnlyDate) and (FillToEnterDate) then Self.Text:=DateToStr(Now);
  297. end;
  298.  
  299. procedure TMyNewEditJL.DoExit;
  300. begin
  301.   self.Color:=VarCColor;
  302.   if (self.text='') and (FOnlyNumbersDouble=False) and (FOnlyDate=false) then self.text:=ftextDefault;
  303.   if (FOnlyNumbersDouble) and (Self.Text='') then Self.Text:='0';
  304.   if (FOnlyDate) and (Self.Text='') then Self.Text:=DateToStr(Now);
  305.   inherited;
  306. end;
  307.  
  308. //todo esto es cogido del compañero Escafandra de su componente RoundEdit--------------------------
  309.  
  310. procedure TMyNewEditJL.CreateWnd;
  311. begin
  312.   inherited CreateWnd;
  313.   SetRound(FBorderStyle = bsRound);
  314. end;
  315.  
  316.  
  317. procedure TMyNewEditJL.SetRound(Value: boolean);
  318. var
  319.   Rgn: HRGN;
  320. begin
  321.   Rgn:= 0;
  322.   if Value then
  323.     Rgn := CreateRoundRectRgn(0, 0, Width+1, Height+1, FBorderRadio-2, FBorderRadio-2) ;
  324.   SetWindowRgn(Handle, Rgn, true);
  325.   DeleteObject(Rgn);
  326. end;
  327.  
  328. procedure TMyNewEditJL.SetBorderColor(Color: TColor);
  329. begin
  330.   FBorderColor:= Color;
  331.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  332.   Invalidate;
  333. end;
  334.  
  335.  
  336. procedure TMyNewEditJL.SetBorderRadio(Radio: integer);
  337. begin
  338.   if Radio <= 10 then
  339.   begin
  340.     FBorderRadio:= Radio;
  341.     SetRound(true);
  342.     RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  343.   end;
  344. end;
  345.  
  346. procedure TMyNewEditJL.SetBorderStyle(Value: TBorderStyle);
  347. begin
  348.   if Value <> FBorderStyle then
  349.   begin
  350.     FBorderStyle:= Value;
  351.     SetRound(false);
  352.     inherited Ctl3D:= Ctl3D;
  353.     case Value of
  354.       bsNone:  inherited BorderStyle := Forms.TBorderStyle(bsNone);
  355.       bsSingle: inherited BorderStyle := Forms.TBorderStyle(bsSingle);
  356.       bsRound:
  357.       begin
  358.         inherited BorderStyle := Forms.TBorderStyle(bsSingle);
  359.         inherited Ctl3D:= true;
  360.         SetRound(true);
  361.       end;
  362.     end;
  363.     RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  364.   end;
  365. end;
  366.  
  367.  
  368. procedure TMyNewEditJL.SetBorderThick(Value: Integer);
  369. begin
  370.   if FBorderThick<>value then FBorderThick:=Value;      //añadido por mi
  371. end;
  372.  
  373. procedure TMyNewEditJL.WMNCPaint(var Message: TMessage);
  374. var
  375.   Brush: TBrush;
  376.   Pen: TPen;
  377.   DC: HDC;
  378.   Clip: integer;
  379. begin
  380.   if (BorderStyle <> bsRound) or not inherited Ctl3D then
  381.   begin
  382.     inherited;
  383.       exit;
  384.   end;
  385.  
  386.   DC:= GetWindowDC(Handle);
  387.   Brush:= TBrush.Create;
  388.   Pen:= TPen.Create;
  389.   Pen.Color:= BorderColor;
  390.   Pen.Width:=FBorderThick;  //añadido por mi
  391.   Brush.Color:= Color;
  392.  
  393.   ExcludeClipRect(DC, 4, 4, Width-4, Height-4);
  394.   Windows.SelectObject(DC, Brush.Handle);
  395.   Windows.SelectObject(DC, Pen.Handle);
  396.  
  397.   Windows.Rectangle(DC, 0, 0, Width, Height);
  398.   Brush.Style:= bsClear;
  399.   Windows.RoundRect(DC, 0, 0, Width, Height,  FBorderRadio, FBorderRadio);
  400.  
  401.   Windows.ReleaseDC(Handle, DC);
  402.   Brush.Destroy;
  403.   Pen.Destroy;
  404. end;
  405.  
  406. procedure TMyNewEditJL.WMSize(var Message: TWMSize);
  407. var r : TRect;
  408. begin
  409.   inherited;
  410.   r := ClientRect;
  411.   SetRound(True);
  412.   InvalidateRect(handle,@r,false);
  413.   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  414. end;
  415.  
  416. end.


  • 0

#6 ELKurgan

ELKurgan

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 556 mensajes
  • LocationEspaña

Escrito 01 junio 2013 - 11:35

Muchas gracias por el aporte, amigo

(y) (y)
  • 0